home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / tdk_v120.zip / DOORKIT2.PAS < prev    next >
Pascal/Delphi Source File  |  1996-07-23  |  69KB  |  1,972 lines
  1. {
  2.  ▀▀▀▀▀▀▀▀  ▀▀▀▀▀▀    ▀▀   ▀▀
  3.    ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  4.   ▀▀     ▀▀   ▀▀▀  ▀▀▀▀▀  The DoorKit!
  5.  ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  6. ▀▀     ▀▀▀▀▀▀    ▀▀    ▀▀
  7. The BBS Door Development Kit By The People - For The People!
  8.  
  9.  
  10.    Feel free to modify or optimize this code at will. All I ask is that if
  11.    find a better way to do things (and you will), please send me a copy of
  12.    your modifications. Thanks in advance!....Larry L. Athey....
  13.  
  14.    This is the secondary DoorKit unit with all the artsy/fartsy functions.
  15.    This unit also contains all of the really "Functional" routines to make
  16.    writing doors easier.  Although there are some things in here you might
  17.    consider to be redundant, they are mainly in here for cosmetic purposes.}
  18.  
  19. {$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
  20. {$M 65520,0,655360}
  21. UNIT DOORKIT2;
  22.  
  23. INTERFACE
  24.  
  25. USES DOS, CRT, DOORKIT1;
  26.  
  27. CONST
  28.   Wraplength : BYTE = 78;    {The maximum word length for input driver.}
  29.   DVseg      : WORD = $B800; {B800=Color, B000=Mono}
  30.   DVofs      : WORD = $0000; {The OFS is needed in case I/You create routines
  31.                               that will write to a virtual page, virtual pages
  32.                               will not always start at 0000. For more exaples
  33.                               of writing to virtual pages see ANSIUNIT.PAS}
  34. VAR
  35.   ProgramName   : STRING[80];{Name and version of the current program}
  36.   ProgramDesc   : STRING[80];{Description of the current program}
  37.   ErrLevel      : BYTE;      {Errorlevel to exit with}
  38.  
  39. {─--[Headers]-──────────────────────────────────────────────────────────────}
  40.  
  41. PROCEDURE FillWord(VAR X; Count : WORD; A : BYTE; C : CHAR);
  42. {^ Just like FillChar, except you give it 2 bytes to use for the fill.
  43.    This is also a 16 Bit procedure, unlike the 8 Bit fillchar TP uses.
  44.    This is useful for filling in a text screen.}
  45. FUNCTION IsOlder(F1,F2 : STRING) : BOOLEAN;
  46. {^ Is file #1 older than file #2?}
  47. FUNCTION GetFileName(InString: String): STRING;
  48. {^ Takes a full path and file name and returns just the file name.}
  49. FUNCTION GetFilePath(InString: String): STRING;
  50. {^ Takes a full path and file name and returns just the path.}
  51. FUNCTION FSize(Fn : PathStr) : LONGINT;
  52. {^ Returns the size of the file "Fn" in bytes.}
  53. FUNCTION FErase(Fn : PathStr) : BOOLEAN;
  54. {^ Erases the file "Fn" from the hard drive.}
  55. FUNCTION FExist(Fn : PathStr) : BOOLEAN;
  56. {^ Returns true if the file "Fn" exists.}
  57. FUNCTION DExist(Fn : PathStr) : BOOLEAN;
  58. {^ Returns true if the directory "Fn" exists.}
  59. PROCEDURE MakeDir(DirName : STRING);
  60. {^ Like MkDir only checks for the directory's existence first.}
  61. FUNCTION CopyFile(SourceFile,TargetFile : STRING) : BYTE;
  62. {^ Copies SourceFile to TargetFile and returns a result code.}
  63. FUNCTION CommaInt(Number : LONGINT) : STRING;
  64. {^ Inserts commas into a number and returns a string of the number with the
  65.    commas. ie: s:=Commint(1000000); (* s='1,000,000' *) Makes Larger numbers
  66.    easier to read.}
  67. FUNCTION PadLeft(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
  68. {^ Pad the front of the string with CH, up to LEN.}
  69. FUNCTION PadRight(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
  70. {^ Pad the end of the string with CH, up to LEN.}
  71. FUNCTION IStr(N : LONGINT; Pad : BYTE) : STRING;
  72. {^ Converts a number to a string with padding.
  73.    Pad = how many 0's will be padded in front of the string, to make
  74.          the number a certain length. ie: istr(45,3) = '045'}
  75. FUNCTION IntToStr(N : LONGINT) : STRING;
  76. {^ Converts a number to a string with no 0 padding.}
  77. FUNCTION StrToInt(S : STRING) : LONGINT;
  78. {^ Converts a string to a number. If the string is invalid, 0 is returned.}
  79. FUNCTION BooleanToStr(B : BOOLEAN) : STRING;
  80. {^ Does not produce the same "TRUE" "FALSE" as pascal, but "True" "False".}
  81. FUNCTION BoolToStr(B : BOOLEAN) : STRING;
  82. {^ Converts BOOLEANs to Ys and Ns}
  83. FUNCTION StrToBool(S : STRING) : BOOLEAN;
  84. {^ If S[1] = 'Y' Then StrToBool := TRUE Else StrToBool := FALSE;}
  85. FUNCTION UpChar(Ch : CHAR) : CHAR;
  86. {^ Converts the char to upper case, this also supports some foreign chars.}
  87. FUNCTION LowChar(Ch : CHAR) : CHAR;
  88. {^ Converts the char to lower case. "                 "                 ".}
  89. FUNCTION NoPath(Txt : STRING) : STRING;
  90. {^ Removes blankspaces and trailing backslash from a directory name.}
  91. FUNCTION FixPath(Txt : STRING) : STRING;
  92. {^ Adds a trailing backslash to a directory name.}
  93. FUNCTION AllCaps(S : STRING) : STRING;
  94. {^ Conerts a string to upper case (uses Upchar)}
  95. FUNCTION Lower(S : STRING) : STRING;
  96. {^ Converts a string to lower case (uses Lowchar)}
  97. FUNCTION Proper(S : STRING) : STRING;
  98. {^ Converts a string to a properly capitalized string.}
  99. FUNCTION Dup(Ch : CHAR; Times : BYTE) : STRING;
  100. {^ Dups Ch "times" and returns, good for things like: "---------------" }
  101. FUNCTION Center(St : STRING; MaxPlace : BYTE) : STRING;
  102. {^ Center the text string to fit in between MaxPlace.}
  103. FUNCTION StripLead(St : STRING; Ch : CHAR) : STRING;
  104. FUNCTION StripTrail(St : STRING; Ch : CHAR) : STRING;
  105. FUNCTION StripBoth(St : STRING; Ch : CHAR) : STRING;
  106. {^ The above functions will strip characters from the beginning and ends of
  107.    a string. "Ch" is the character you wish to strip.}
  108. FUNCTION IntToHex(Num : LONGINT; Digits : BYTE) : STRING;
  109. {^ Converts an integer value to a hexadecimal string.}
  110. FUNCTION HexToInt(HexStr : STRING) : LONGINT;
  111. {^ Converts a hexadecimal string to integer value.}
  112. PROCEDURE HideCursor;
  113. {^ LOCAL ONLY: turns the cursor off}
  114. PROCEDURE ShowCursor;
  115. {^ LOCAL ONLY: turns the cursor on.}
  116. PROCEDURE SetCursorSize(Top,Bot : BYTE);
  117. {^ LOCAL ONLY: Set the size of the cursor. top=top scanline; bot=bottom
  118.    scanline of cursor. Both in the range of 1..8. (7,8)="normal" cursor,
  119.    (1,8)=block cursor....}
  120. PROCEDURE ShowProgramAd;
  121. {^ This will clear the screen and display a banner teliing the name and
  122.    description of your program. You will most likely want to customize
  123.    this before you write any doors with this kit.}
  124. PROCEDURE CPrompt(HotKey : CHAR ; Txt : STRING);
  125. {^ Simply draws text on the screen like most BBSes use in the selections in
  126.    their file listings and message readers. (ie: [S]election). Keeping the
  127.    HotKey and Txt separate is faster than using Copy/Delete on a string.}
  128. PROCEDURE MenuKey(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  129. {^ Just like CPrompt except this draws the prompt at X/Y coordinates on the
  130.    screen. ANSI must be enabled for this to work.}
  131. PROCEDURE YesNoBox;
  132. {^ Simply draws a colored [Y/N] on the screen.}
  133. PROCEDURE FancyPrompt;
  134. {^ Displays a fancy "Your Selection:" on the screen.}
  135. PROCEDURE Select;
  136. {^ Displays a fancy "Select:" on the screen.}
  137. PROCEDURE YnPrompt(Txt : STRING);
  138. {^ Prints your "Txt" on the screen followed by a colored [Y/n].}
  139. PROCEDURE NyPrompt(Txt : STRING);
  140. {^ Prints your "Txt" on the screen followed by a colored [y/N].}
  141. PROCEDURE AnyKey;
  142. {^ Displays a nice "Press Any Key To Continue" prompt and waits for keypress.}
  143. PROCEDURE OutTxt(FG,BG : BYTE ; Txt : STRING);
  144. {^ Special procedure. Prints text on both screens in the colors
  145.    specified by the FG and BG variables. If the user does not have
  146.    ANSI enabled, then no color codes are sent.}
  147. PROCEDURE OutTxtL(FG,BG : BYTE ; Txt : STRING);
  148. {^ Same as above except a line feed is sent after the text.}
  149. PROCEDURE OutTxtXY(X,Y,FG,BG : BYTE ; Txt : STRING);
  150. {^ Special procedure. Prints text on both screens at X/Y coordinates
  151.    in the colors specified by the FG and BG variables. This procedure
  152.    requires the user to have ANSI enabled!}
  153. PROCEDURE OutTxtXYL(X,Y,FG,BG : BYTE ; Txt : STRING);
  154. {^ Same as above except a line feed is sent after the text.}
  155. FUNCTION SecretInput(Len : BYTE; Default : STRING) : STRING;
  156. {^ Special procedure. Creates an input field for getting passwords.
  157.    the result of all input is hidden from the user's view.}
  158. FUNCTION NameInput(Len : BYTE; Default : STRING) : STRING;
  159. {^ Special procedure. Creates an input field that will automatically
  160.    force all input to proper case.}
  161. FUNCTION NormalInput(Len : BYTE; Default : STRING) : STRING;
  162. {^ Special procedure. Creates an input field, all characters accepted}
  163. FUNCTION CapsInput(Len : BYTE; Default : STRING) : STRING;
  164. {^ Special procedure. Creates an input field that will automatically
  165.    force all input to upper case letters}
  166. FUNCTION NumberInput(Len : BYTE; Default : STRING) : STRING;
  167. {^ Special procedure. Creates an input field but will only allow the
  168.    input of numeric characters}
  169. FUNCTION NamePrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  170. {^ Similar to NameInput except the user is required to have ANSI
  171.    enabled. This will produce an input field on the screen filled
  172.    with underscores and will have a bracket on both ends.}
  173. FUNCTION NormalPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  174. {^ Similar to NormalInput but follows the same rules as NamePrompt.}
  175. FUNCTION NumberPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  176. {^ Similar to NumberInput but follows the same rules as NamePrompt.}
  177. FUNCTION SecretPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  178. {^ Similar to SecretInput but follows the same rules as NamePrompt.}
  179. FUNCTION CapsPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  180. {^ Similar to CapsInput but follows the same rules as NameIprompt.}
  181. FUNCTION SysField(X,Y,Style,StrLength : BYTE ; InStr : STRING) : STRING;
  182. {^ Special procedure. Say for example you wanted to create a feature in
  183.    your door where you have various input fields at specific locations.
  184.    You would use this to draw a fields on the screen. Then you would use
  185.    it in conjunction with the next procedure to make it look like your
  186.    fields are shifting and showing the field that is active. ANSI must
  187.    be enabled. (Style = 0-Normal 1-Number 2-Name 3-Secret 4-Caps)}
  188. PROCEDURE DummyField(X,Y,StrLength : BYTE ; InStr : STRING);
  189. {^ See the above description.}
  190. PROCEDURE DrawWin(X1,Y1,X2,Y2 : BYTE ; Title : STRING);
  191. {^ Draws a window on both screens at X1,Y1,X2,Y2 coordinates with a title.
  192.    ANSI graphics required for this.'}
  193. PROCEDURE ClearWin(X1,Y1,X2,Y2 : BYTE);
  194. {^ Clears a window with the CS.Wbg color, ANSI graphics required for this.}
  195. PROCEDURE DrawButton(HotKey : CHAR ; Txt : STRING ; HighLight : BOOLEAN);
  196. {^ Draws a simulated raised button on the screen.}
  197. PROCEDURE SysButton(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  198. {^ Draws a simulated raised button on the screen at X/Y coorinates. This is
  199.    mainly meant to be used with DrawWin since the button uses the window
  200.    background color on its edges. ANSI is required for this.}
  201. PROCEDURE DrawMenu(X1,Y1,X2,Y2 : BYTE);
  202. {^ Creates a simulated drop down menu at X1,Y1,X2,Y2, ANSI required.}
  203. PROCEDURE MenuItem(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  204. {^ Adds a selection to a drop down menu, ANSI required.}
  205. PROCEDURE MenuLine(X,Y,L : BYTE);
  206. {^ Adds a dividing line to a drop down menu, ANSI required.}
  207. PROCEDURE MenuBarItem(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  208. {^ Since you are making simulated drop down menus, they have to drop down
  209.    from a menu bar. Most times a menu bar is nothing more than going to the
  210.    1,1 coordinate and doing an sClrEol. After that, you will add items to
  211.    your menu bar. ANSI required.}
  212. PROCEDURE InfoBox(Width : BYTE ; Height : BYTE);
  213. {^ Creates a nice 3D frame on the screen, ANSI required.}
  214. PROCEDURE InfoText(Txt : STRING);
  215. {^ Creates a nice banner on the screen just like AnyKey does.}
  216. PROCEDURE LineBar(FG,BG,L : BYTE);
  217. {^ Draws a thin line across the screen in FG/BG colors at L length.}
  218. PROCEDURE RunEntryForm(ScriptFile : STRING);
  219. {^ Runs a Dynamic Entry Form (ie: Script).}
  220. PROCEDURE Log(LogLine : STRING);
  221. {^ Use this if you are using activity logging.}
  222. PROCEDURE Terminate(S : STRING);
  223. {^ Halts the program with the Error String "S".}
  224. PROCEDURE ErrorLog(LogLine : STRING ; ELevel : BYTE ; BailOut : BOOLEAN);
  225. {^ Use this if you are tracking errors in your program. If BailOut is True,
  226.    then the program will terminate immediately after writing to the log.}
  227. PROCEDURE CvtColors(InStr : STRING ; LF : BOOLEAN);
  228. {^ Displays a text string with embedded "Fancy Bracket" color codes and
  229.    automatically changes color of the text is displayed. (If LF is true,
  230.    a linefeed will be sent).}
  231. FUNCTION CvtVars(Txt : STRING) : STRING;
  232. {^ Converts a string with embedded global system veriables to a translated
  233.    string. You may add/change variables as you see fit.}
  234. FUNCTION DateVariable : STRING;
  235. {^ Returns a nice MM/DD/YY formatted date string.}
  236. FUNCTION TimeVariable : STRING;
  237. {^ Returns a nice ##:##am or ##:##pm formatted time string.}
  238. PROCEDURE RipToText;
  239. {^ If a caller is connected in RIP graphics mode, you must make a call to
  240.    this procedure to throw RIPterm back into text mode. To throw RIPterm
  241.    back into RIP graphics mode, simply use ShowScreen() to display a *.RIP}
  242. PROCEDURE ShowTextFile(TextFile : STRING);
  243. {^ This displays a text file to the user in the "Text Reader" where they
  244.    can use [P]revious, [N]ext, [T]op, [B]ottom and [Q]uit keys.}
  245. PROCEDURE ShowScreen(Scr : STRING);
  246. {^ This is a non-stop display of an ANSI/ASCII/RIP/MAX screen file where
  247.    each line is checked for global system variables and translated.}
  248. PROCEDURE ChatSelect;
  249. {^ This procedure can be called from any other procedure to throw the door
  250.    into SysOp/User chat. Depending on the user's graphics capabilities, the
  251.    door will decide which chat mode to use. There are split screen chat and
  252.    line chat chat modes. Line chat mode will only be used in the event the
  253.    caller only has TTY graphics capabilities.}
  254. PROCEDURE AlertTones;
  255. {^ Produces five ^G tones with a 200ms delay between tones. Use this to alert
  256.    the user of an error. The sysop will only hear the tones if the door is
  257.    running locally, otherwise the tones are sent straight to the comport.}
  258. PROCEDURE DVWrite(X,Y : WORD; Attr : BYTE; S : STRING);
  259. {^ No this doesn't have anything to do with DesqView. This means Direct Video
  260.    Write. This allows you to display something on the local screen without it
  261.    ever affecting the user's video. You can change colors, move the cursor to
  262.    specific X/Y coordinates, you name it, and there is never any effect on the
  263.    user's screen. That's just an advantage of writing directly to the video
  264.    RAM rather than going through the BIOS.}
  265.  
  266. {───────────────────────────────────────────────────────────────────────────}
  267.  
  268. IMPLEMENTATION
  269.  
  270. USES ANSIUNIT;
  271.  
  272. {───────────────────────────────────────────────────────────────────────────}
  273. PROCEDURE FillWord(VAR X; Count : WORD; A : BYTE; C : CHAR); Assembler;
  274. Asm
  275.   les   di,X
  276.   mov   cx,[Count]
  277.   shr   cx,1
  278.   mov   al,[C]
  279.   mov   ah,[A]
  280.   rep   stosw
  281.   test  [Count],1 {Just in case you give it an odd count.}
  282.   jz    @END
  283.   stosb
  284. @END :
  285. END;
  286. {───────────────────────────────────────────────────────────────────────────}
  287. FUNCTION IsOlder(F1,F2 : STRING) : BOOLEAN;
  288. VAR
  289.   DInfo1  : SEARCHREC;
  290.   DInfo2  : SEARCHREC;
  291.   D1      : DATETIME;
  292.   D2      : DATETIME;
  293.   I1      : LONGINT;
  294.   I2      : LONGINT;
  295. BEGIN
  296.   IsOlder := FALSE;
  297.   FINDFIRST(F1,Archive,DInfo1); I1 := DInfo1.Time; UNPACKTIME(I1,D1);
  298.   FINDFIRST(F2,Archive,DInfo2); I2 := DInfo2.Time; UNPACKTIME(I2,D2);
  299.   IF (D1.Year < D2.Year) THEN IsOlder := TRUE;
  300.   IF (D1.Year = D2.Year) AND (D1.Month < D2.Month) THEN IsOlder := TRUE;
  301.   IF (D1.Year = D2.Year) AND (D1.Month = D2.Month) AND (D1.Day < D2.Day) THEN IsOlder := TRUE;
  302.   IF (D1.Month = D2.Month) AND (D1.Day = D2.Day) AND (D1.Year = D2.Year) THEN BEGIN
  303.     IF (D1.Hour < D2.Hour) THEN IsOlder := TRUE;
  304.     IF (D1.Hour = D2.Hour) AND (D1.Min < D2.Min) THEN IsOlder := TRUE;
  305.   END;
  306. END;
  307. {───────────────────────────────────────────────────────────────────────────}
  308. FUNCTION GetFileName(InString: String): STRING;
  309. VAR
  310.   Work : BYTE;
  311. BEGIN
  312.   InString := StripBoth(InString,' ');
  313.   REPEAT
  314.     Work := POS('\',InString);
  315.     IF Work<>0 THEN DELETE(InString,1,Work);
  316.   UNTIL Work=0;
  317.   GetFileName := InString;
  318. END;
  319. {───────────────────────────────────────────────────────────────────────────}
  320. FUNCTION GetFilePath(InString: String): STRING;
  321. VAR
  322.   Loop : BYTE;
  323. BEGIN
  324.   InString := StripBoth(InString,' ');
  325.   IF InString[Length(InString)]='\' THEN
  326.   BEGIN
  327.     GetFilePath := InString;
  328.     Exit;
  329.   END;
  330.   Loop := LENGTH(InString);
  331.   REPEAT
  332.     DEC(Loop);
  333.   UNTIL ((Loop=0) OR (InString[Loop]='\'));
  334.   IF Loop<>0 THEN DELETE(InString,Loop+1,LENGTH(InString)-Loop) ELSE InString := '';
  335.   GetFilePath := InString;
  336. END;
  337. {───────────────────────────────────────────────────────────────────────────}
  338. FUNCTION FSize(Fn : PathStr) : LONGINT;
  339. VAR
  340.   F : FILE;
  341. BEGIN
  342.   ASSIGN(F,Fn);
  343.   RESET(F,1);
  344.   IF IORESULT = 0 THEN BEGIN
  345.     FSize := FILESIZE(F);
  346.     CLOSE(F);
  347.   END;
  348. END;
  349. {───────────────────────────────────────────────────────────────────────────}
  350. FUNCTION FErase(Fn : PathStr) : BOOLEAN;
  351. VAR
  352.   F : FILE;
  353. BEGIN
  354.   ASSIGN(F,Fn);
  355.   ERASE(F);
  356.   FErase := IORESULT = 0;
  357. END;
  358. {───────────────────────────────────────────────────────────────────────────}
  359. FUNCTION FExist(Fn : PathStr) : BOOLEAN;
  360. VAR
  361.   DirInfo : SEARCHREC;
  362. BEGIN
  363.   FINDFIRST(Fn,Anyfile - Directory - VolumeID,DirInfo);
  364.   FExist := DOSERROR = 0;
  365. END;
  366. {───────────────────────────────────────────────────────────────────────────}
  367. FUNCTION DExist(Fn : PathStr) : BOOLEAN;
  368. VAR
  369.   OrgDir : PathStr;
  370. BEGIN
  371.   Fn := NoPath(FExpand(Fn));
  372.   GETDIR(BYTE(Fn[1]) - BYTE('A') + 1,OrgDir);
  373.   CHDIR(Fn);
  374.   DExist := IORESULT = 0;
  375.   CHDIR(OrgDir);
  376. END;
  377. {───────────────────────────────────────────────────────────────────────────}
  378. PROCEDURE MakeDir(DirName : STRING);
  379. BEGIN
  380.   DirName := NoPath(AllCaps(DirName));
  381.   IF NOT DExist(DirName) THEN MKDIR(DirName);
  382. END;
  383. {───────────────────────────────────────────────────────────────────────────}
  384. FUNCTION CopyFile(SourceFile,TargetFile : STRING) : BYTE;
  385. { Return Codes:  0 Successful
  386.                  1 Source and target the same
  387.                  2 Cannot open source
  388.                  3 Unable to create target
  389.                  4 Error during copy }
  390. VAR
  391.   Source,
  392.   Target  : FILE;
  393.   BRead,
  394.   BWrite  : WORD;
  395.   FileBuf : ARRAY[1..2048] OF CHAR;
  396. BEGIN
  397.   SourceFile := StripBoth(SourceFile,' ');
  398.   TargetFile := StripBoth(TargetFile,' ');
  399.   IF SourceFile = TargetFile THEN BEGIN
  400.     CopyFile := 1;
  401.     EXIT;
  402.   END;
  403.   ASSIGN(Source,SourceFile);
  404.   {$I-}RESET(Source,1);{$I+}
  405.   IF IORESULT <> 0 THEN BEGIN
  406.     CopyFile := 2;
  407.     EXIT;
  408.   END;
  409.   ASSIGN(Target,TargetFile);
  410.   {$I-}REWRITE(Target,1);{$I+}
  411.   IF IORESULT <> 0 THEN BEGIN
  412.     CopyFile := 3;
  413.     EXIT;
  414.   END;
  415.   REPEAT
  416.     BLOCKREAD(Source,FileBuf,SIZEOF(FileBuf),BRead);
  417.     BLOCKWRITE(Target,FileBuf,Bread,BWrite);
  418.   UNTIL (BRead = 0) OR (BRead <> BWrite);
  419.   CLOSE(Source);
  420.   CLOSE(Target);
  421.   IF BRead <> BWrite THEN CopyFile := 4 ELSE CopyFile := 0;
  422. END;
  423. {───────────────────────────────────────────────────────────────────────────}
  424. FUNCTION CommaInt(Number : LONGINT) : STRING;
  425. VAR
  426.   NumStr : STRING[15];
  427.   Len    : BYTE;
  428.   I      : BYTE;
  429. BEGIN
  430.   STR(Number,NumStr);
  431.   Len := LENGTH(NumStr);
  432.   I   := Len + 1;
  433.   WHILE (I > 4) AND (I <= Len + 1) DO BEGIN
  434.     DEC(I,3);
  435.     INSERT(',',NumStr,I);
  436.   END;
  437.   CommaInt := NumStr;
  438. END;
  439. {───────────────────────────────────────────────────────────────────────────}
  440. FUNCTION PadRight(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
  441. BEGIN
  442.   WHILE LENGTH(S) < Len DO S := S + Ch;
  443.   PadRight := S;
  444. END;
  445. {───────────────────────────────────────────────────────────────────────────}
  446. FUNCTION PadLeft(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
  447. BEGIN
  448.   WHILE LENGTH(S) < Len DO S := Ch + S;
  449.   PadLeft := S;
  450. END;
  451. {───────────────────────────────────────────────────────────────────────────}
  452. FUNCTION IStr(N : LONGINT; Pad : BYTE) : STRING;
  453. VAR
  454.   St : STRING[20];
  455. BEGIN
  456.   STR(N,St);
  457.   WHILE LENGTH(St) < Pad DO INSERT('0',St,1);
  458.   IStr := St;
  459. END;
  460. {───────────────────────────────────────────────────────────────────────────}
  461. FUNCTION IntToStr(N : LONGINT) : STRING;
  462. VAR
  463.   St : STRING;
  464. BEGIN
  465.   STR(N,St);
  466.   IntToStr := St;
  467. END;
  468. {───────────────────────────────────────────────────────────────────────────}
  469. FUNCTION StrToInt(S : STRING) : LONGINT;
  470. VAR
  471.   L : LONGINT;
  472.   U : INTEGER;
  473. BEGIN
  474.   VAL(S,L,U);
  475.   StrToInt := L;
  476. END;
  477. {───────────────────────────────────────────────────────────────────────────}
  478. FUNCTION BooleanToStr(B : BOOLEAN) : STRING;
  479. BEGIN
  480.   IF B THEN BooleanToStr := 'True' ELSE BooleanToStr := 'False';
  481. END;
  482. {───────────────────────────────────────────────────────────────────────────}
  483. FUNCTION BoolToStr(B : BOOLEAN) : STRING;
  484. BEGIN
  485.   IF B THEN BoolToStr := 'Y' ELSE BoolToStr := 'N';
  486. END;
  487. {───────────────────────────────────────────────────────────────────────────}
  488. FUNCTION StrToBool(S : STRING) : BOOLEAN;
  489. BEGIN
  490.   S := StripBoth(S,' ');
  491.   S := AllCaps(S);
  492.   IF POS('Y',S) = 1 THEN StrToBool := TRUE ELSE StrToBool := FALSE;
  493. END;
  494. {───────────────────────────────────────────────────────────────────────────}
  495. FUNCTION UpChar(Ch : CHAR) : CHAR;
  496. BEGIN
  497.   IF Ch IN [#97..#122] THEN Ch := CHR(BYTE(Ch) AND $DF)
  498.     ELSE IF Ch = '¢' THEN Ch := '¥' ELSE IF Ch = 'å' THEN Ch := 'Å'
  499.     ELSE IF Ch = 'ä' THEN Ch := 'Ä' ELSE IF Ch = 'ç' THEN Ch := 'Ç'
  500.     ELSE IF Ch = 'é' THEN Ch := 'É' ELSE IF Ch = 'ö' THEN Ch := 'Ö'
  501.     ELSE IF Ch = 'ñ' THEN Ch := 'Ñ' ELSE IF Ch = 'ü' THEN Ch := 'Ü';
  502.   UpChar := Ch;
  503. END;
  504. {───────────────────────────────────────────────────────────────────────────}
  505. FUNCTION LowChar(Ch : CHAR) : CHAR;
  506. BEGIN
  507.   IF Ch IN [#65..#90] THEN Ch := CHR(BYTE(ch) AND $20)
  508.     ELSE IF Ch = '¥' THEN Ch := '¢' ELSE IF Ch = 'Å' THEN Ch := 'å'
  509.     ELSE IF Ch = 'Ä' THEN Ch := 'ä' ELSE IF Ch = 'Ç' THEN Ch := 'ç'
  510.     ELSE IF Ch = 'É' THEN Ch := 'é' ELSE IF Ch = 'Ö' THEN Ch := 'ö'
  511.     ELSE IF Ch = 'Ñ' THEN Ch := 'ñ' ELSE IF Ch = 'Ü' THEN Ch := 'ü';
  512.   LowChar := Ch;
  513. END;
  514. {───────────────────────────────────────────────────────────────────────────}
  515. FUNCTION NoPath(Txt : STRING) : STRING;
  516. VAR
  517.   Work : BYTE;
  518. BEGIN
  519.   Txt := StripBoth(Txt,' ');
  520.   Txt := StripTrail(Txt,'\');
  521.   NoPath := Txt;
  522. END;
  523. {───────────────────────────────────────────────────────────────────────────}
  524. FUNCTION FixPath(Txt : STRING) : STRING;
  525. VAR
  526.   Loop,EndCh : BYTE;
  527. BEGIN
  528.   Txt := StripBoth(Txt,' ');
  529.   EndCh := LENGTH(Txt);
  530.   FOR Loop := 1 TO LENGTH(Txt) DO Txt[Loop] := UPCASE(Txt[Loop]);
  531.   IF Txt[EndCh] <> '\' THEN Txt := Txt + '\';
  532.   FixPath := Txt;
  533. END;
  534. {───────────────────────────────────────────────────────────────────────────}
  535. FUNCTION AllCaps(S : STRING) : STRING;
  536. VAR
  537.   SLen : BYTE ABSOLUTE S;
  538.   X    : INTEGER;
  539. BEGIN
  540.   FOR X := 1 TO SLen DO S[X] := UpChar(S[X]);
  541.   AllCaps := S;
  542. END;
  543. {───────────────────────────────────────────────────────────────────────────}
  544. FUNCTION Lower(S : STRING) : STRING;
  545. VAR
  546.   SLen : BYTE ABSOLUTE S;
  547.   I    : INTEGER;
  548. BEGIN
  549.   FOR I := 1 TO SLen DO S[I] := LowChar(S[I]);
  550.   Lower := S;
  551. END;
  552. {───────────────────────────────────────────────────────────────────────────}
  553. FUNCTION Proper(S : STRING) : STRING;
  554. VAR
  555.   SLen : BYTE ABSOLUTE S;
  556.   I    : INTEGER;
  557. BEGIN
  558.   S := Lower(S);
  559.   FOR I := 1 TO SLen DO BEGIN
  560.     IF I = 1 THEN S[1] := UpChar(S[1])
  561.     ELSE IF S[I-1] = ' ' THEN S[i] := UpChar(S[i])
  562.     ELSE IF (ORD(S[I-1]) IN [32..64]) AND (S[i-1] <> '''')
  563.     THEN S[I] := UpChar(S[I]);
  564.   END;
  565.   Proper := S;
  566. END;
  567. {───────────────────────────────────────────────────────────────────────────}
  568. FUNCTION Dup(ch : CHAR; times : BYTE) : STRING;
  569. VAR
  570.   Temp : STRING;
  571. BEGIN
  572.   FILLCHAR(Temp[1],Times,Ch);
  573.   Temp[0] := CHAR(Times);
  574.   Dup := Temp;
  575. END;
  576. {───────────────────────────────────────────────────────────────────────────}
  577. FUNCTION Center(St : STRING; MaxPlace : BYTE) : STRING;
  578. CONST
  579.   JustChar : CHAR = ' ';
  580. VAR
  581.   Temp : STRING;
  582.   Num  : BYTE;
  583. BEGIN
  584.   Num    := (MaxPlace DIV 2) - (LENGTH(St) DIV 2);
  585.   Temp   := Dup(JustChar,Num);
  586.   Temp   := Temp + St;
  587.   Temp   := Temp + Dup(JustChar,MaxPlace - Num - LENGTH(St));
  588.   Center := Temp;
  589. END;
  590. {───────────────────────────────────────────────────────────────────────────}
  591. FUNCTION StripLead(St : STRING; Ch : CHAR) : STRING;
  592. VAR
  593.   TempStr : STRING;
  594. BEGIN
  595.   TempStr := St;
  596.   WHILE ((TempStr[1] = Ch) AND (LENGTH(TempStr) > 0)) DO tempstr := COPY(TempStr,2,LENGTH(TempStr));
  597.   striplead := tempstr;
  598. END;
  599. {───────────────────────────────────────────────────────────────────────────}
  600. FUNCTION StripTrail(St : STRING; Ch : CHAR) : STRING;
  601. VAR
  602.   TempStr : STRING;
  603.   I       : INTEGER;
  604. BEGIN
  605.   TempStr := St;
  606.   I := LENGTH(St);
  607.   WHILE ((I > 0) AND (St[I] = Ch)) DO I := I - 1;
  608.   TempStr[0] := CHR(I);
  609.   StripTrail := TempStr;
  610. END;
  611. {───────────────────────────────────────────────────────────────────────────}
  612. FUNCTION StripBoth(St : STRING; Ch : CHAR) : STRING;
  613. BEGIN
  614.   StripBoth := StripTrail(StripLead(St,Ch),Ch);
  615. END;
  616. {───────────────────────────────────────────────────────────────────────────}
  617. FUNCTION IntToHex(Num : LONGINT; Digits : BYTE) : STRING;
  618. CONST
  619.   HexId : ARRAY[0..$F] OF CHAR = '0123456789ABCDEF';
  620. VAR
  621.   S : STRING;
  622.   C : BYTE;
  623.   N : ARRAY[1..SIZEOF(LONGINT)] OF BYTE ABSOLUTE Num;
  624. BEGIN
  625.   S := '';
  626.   FOR C := 4 DOWNTO 1 DO S := S + HexId[N[C] SHR 4] + HexId[N[C] AND $F];
  627.   IntToHex := COPY(S,8 - Digits + 1,Digits);
  628. END;
  629. {───────────────────────────────────────────────────────────────────────────}
  630. FUNCTION HexToInt(HexStr : STRING) : LONGINT;
  631. VAR
  632.   I,HexNibble : WORD;
  633.   Temp        : LONGINT;
  634.   Code        : INTEGER;
  635. BEGIN
  636.   Temp   := 0;
  637.   HexStr := AllCaps(HexStr);
  638.   FOR I := LENGTH(HexStr) DOWNTO 1 DO IF NOT (HexStr[I] IN ['0'..'9','A'..'F']) THEN DELETE(HexStr,I,1);
  639.   FOR I := LENGTH(HexStr) DOWNTO 1 DO BEGIN
  640.     IF HexStr[I] IN ['0'..'9'] THEN HexNibble := BYTE(HexStr[I]) - BYTE('0')
  641.                                ELSE HexNibble := BYTE(HexStr[I]) - BYTE('A') + 10;
  642.     INC(Temp,LONGINT(HexNibble) * (1 SHL (4 * (LONGINT(LENGTH(HexStr)) - I))));
  643.   END;
  644.   HexToInt := Temp;
  645. END;
  646. {───────────────────────────────────────────────────────────────────────────}
  647. PROCEDURE HideCursor; Assembler;
  648. Asm
  649.   Mov ax,0100h
  650.   Mov cx,2607h
  651.   INT 10h
  652. END;
  653. {───────────────────────────────────────────────────────────────────────────}
  654. PROCEDURE ShowCursor; Assembler;
  655. asm
  656.   Mov ax,0100h
  657.   Mov cx,0506h
  658.   INT 10h
  659. END;
  660. {───────────────────────────────────────────────────────────────────────────}
  661. PROCEDURE SetCursorSize(Top,Bot : BYTE); Assembler;
  662. Asm
  663.   Mov ah,01h
  664.   Mov ch,[Top]
  665.   Mov cl,[Bot]
  666.   INT 10h
  667. END;
  668. {───────────────────────────────────────────────────────────────────────────}
  669. PROCEDURE ShowProgramAd;
  670. BEGIN
  671.   sClrScr;
  672.   LineBar(1,0,79);
  673.   OutTxtL(14,0,ProgramName);
  674.   OutTxtL(9,0,ProgramDesc);
  675.   OutTxtL(11,0,'Copyright 1995-1996 Larry Athey - BBS Utiliteez Software');
  676.   LineBar(1,0,79);
  677. END;
  678. {───────────────────────────────────────────────────────────────────────────}
  679. PROCEDURE CPrompt(HotKey : CHAR ; Txt : STRING);
  680. BEGIN
  681.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('[');
  682.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC(HotKey);
  683.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC(']');
  684.   Set_Color(CS.CPTfg,CS.CPTbg); sWrite(Txt+' ');
  685. END;
  686. {───────────────────────────────────────────────────────────────────────────}
  687. PROCEDURE MenuKey(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  688. BEGIN
  689.   sGotoXY(X,Y);
  690.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('[');
  691.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC(HotKey);
  692.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC(']');
  693.   Set_Color(CS.CPTfg,CS.CPTbg); sWrite(Txt);
  694. END;
  695. {───────────────────────────────────────────────────────────────────────────}
  696. PROCEDURE YesNoBox;
  697. BEGIN
  698.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite(' [');
  699.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('Y');
  700.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('/');
  701.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('N');
  702.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite('] ');
  703. END;
  704. {───────────────────────────────────────────────────────────────────────────}
  705. PROCEDURE FancyPrompt;
  706. BEGIN
  707.   OutTxt(9,0,'Y');
  708.   OutTxt(11,0,'o');
  709.   OutTxt(15,0,'ur Selecti');
  710.   OutTxt(11,0,'o');
  711.   OutTxt(9,0,'n');
  712.   OutTxt(8,0,': ');
  713. END;
  714. {───────────────────────────────────────────────────────────────────────────}
  715. PROCEDURE Select;
  716. BEGIN
  717.   OutTxt(9,0,'S');
  718.   OutTxt(11,0,'e');
  719.   OutTxt(15,0,'le');
  720.   OutTxt(11,0,'c');
  721.   OutTxt(9,0,'t');
  722.   OutTxt(8,0,':');
  723. END;
  724. {───────────────────────────────────────────────────────────────────────────}
  725. PROCEDURE YnPrompt(Txt : STRING);
  726. BEGIN
  727.   Set_Color(CS.CPTfg,CS.CPTbg); sWrite(Txt);
  728.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite(' [');
  729.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('Y');
  730.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('/');
  731.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('n');
  732.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite('] ');
  733. END;
  734. {───────────────────────────────────────────────────────────────────────────}
  735. PROCEDURE NyPrompt(Txt : STRING);
  736. BEGIN
  737.   Set_Color(CS.CPTfg,CS.CPTbg); sWrite(Txt);
  738.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite(' [');
  739.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('N');
  740.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('/');
  741.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('y');
  742.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite('] ');
  743. END;
  744. {───────────────────────────────────────────────────────────────────────────}
  745. PROCEDURE AnyKey;
  746. BEGIN
  747.   Set_Color(1,0);  sClrEol; sWrite('░▒▓');
  748.   Set_Color(15,1); sWrite(' Press Any Key To Continue ');
  749.   Set_Color(1,0);  sWrite('▓▒░');
  750.   sReadKey;
  751. END;
  752. {───────────────────────────────────────────────────────────────────────────}
  753. PROCEDURE OutTxt(FG,BG : BYTE ; Txt : STRING);
  754. BEGIN
  755.   Set_Color(FG,BG);
  756.   sWrite(Txt);
  757. END;
  758. {───────────────────────────────────────────────────────────────────────────}
  759. PROCEDURE OutTxtL(FG,BG : BYTE ; Txt : STRING);
  760. BEGIN
  761.   Set_Color(FG,BG);
  762.   sWriteln(Txt);
  763. END;
  764. {───────────────────────────────────────────────────────────────────────────}
  765. PROCEDURE OutTxtXY(X,Y,FG,BG : BYTE ; Txt : STRING);
  766. BEGIN
  767.   sGotoXY(X,Y);
  768.   Set_Color(FG,BG);
  769.   sWrite(Txt);
  770. END;
  771. {───────────────────────────────────────────────────────────────────────────}
  772. PROCEDURE OutTxtXYL(X,Y,FG,BG : BYTE ; Txt : STRING);
  773. BEGIN
  774.   sGotoXY(X,Y);
  775.   Set_Color(FG,BG);
  776.   sWriteln(Txt);
  777. END;
  778. {───────────────────────────────────────────────────────────────────────────}
  779. FUNCTION InputDriver(Len : BYTE; Name,Showit,AllCap,NumInput : BOOLEAN; tLine : STRING) : STRING;
  780. VAR
  781.   Ch      : CHAR;
  782.   Insrt   : BOOLEAN;
  783.   Loop,
  784.   J,Place : BYTE;
  785.   Temp,
  786.   RTemp   : STRING;
  787. BEGIN
  788.   Insrt := TRUE;
  789.   IF tLine = '' THEN Place := 1 ELSE Place := LENGTH(tLine)+1;
  790.   REPEAT
  791.     Ch := sReadKey;
  792.     IF Name THEN BEGIN
  793.       IF Place = 1 THEN Ch := UPCASE(Ch) ELSE IF tLine[Place-1] = #32 THEN Ch := UPCASE(Ch);
  794.     END;
  795.     IF AllCap THEN Ch := UPCASE(Ch);
  796.     IF (NumInput AND (Ch IN [#0..#31,'0'..'9','-','+'])) OR NOT NumInput THEN
  797.     CASE Ch OF
  798.       #0,
  799.       #22,
  800.       #27,
  801.       #127:BEGIN
  802.              Temp := Ch;
  803.              IF Ch = #0  THEN Temp := s_ReadKey;
  804.              IF Ch = #27 THEN Temp := Temp + sReadKey + sReadKey;
  805.              IF Ch = #22 THEN BEGIN
  806.                sWaitInput(250);
  807.                IF sKeyPressed THEN Temp := Temp + sReadKey;
  808.              END;
  809.              J := 0;
  810.              REPEAT
  811.                IF Temp = CursorMove.Home[J] THEN BEGIN
  812.                  IF Place-1 <> 0 THEN sCursorLeft(Place-1);
  813.                  Place := 1;
  814.                  Temp  := '';
  815.                END ELSE IF Temp = CursorMove.EndKey[J] THEN BEGIN
  816.                  IF LENGTH(tLine) - Place+1 <> 0 THEN sCursorRight(LENGTH(tLine)-Place+1);
  817.                  Place := BYTE(tLine[0])+1;
  818.                  Temp  := '';
  819.                END ELSE IF Temp = CursorMove.Left[J] THEN BEGIN
  820.                  IF Place <> 1 THEN BEGIN
  821.                    DEC(Place);
  822.                    sCursorLeft(1);
  823.                  END;
  824.                  Temp := '';
  825.                END ELSE IF Temp = CursorMove.Right[J] THEN BEGIN
  826.                  IF Place < BYTE(tLine[0])+1 THEN BEGIN
  827.                    INC(Place);
  828.                    sCursorRight(1);
  829.                  END;
  830.                  Temp := '';
  831.                END ELSE IF Temp = CursorMove.Insert[J] THEN BEGIN
  832.                  Insrt := NOT Insrt;
  833.                  Temp  := '';
  834.                END ELSE IF Temp = CursorMove.Delete[J] THEN BEGIN
  835.                  Temp := '';
  836.                  IF Place < BYTE(tLine[0])+1 THEN BEGIN
  837.                    DELETE(tLine,Place,1);
  838.                    IF ShowIt THEN sWrite(COPY(tLine,Place,255)+BackSpaceChar)
  839.                    ELSE sWrite(#25'■'+CHAR(BYTE(tLine[0]) - Place+1)+BackSpaceChar);
  840.                    sCursorLeft(BYTE(tLine[0]) - Place+1+1);
  841.                  END;
  842.                END;
  843.                INC(J);
  844.              UNTIL (J = Avatar) OR (Temp = '');
  845.            END;
  846.       #8 : IF Place <> 1 THEN BEGIN
  847.              IF Place = BYTE(tLine[0])+1 THEN BEGIN
  848.                DEC(tLine[0]);
  849.                sWrite(#8+BackSpaceChar{+#22#5}); {#22#5 is for Avatar}
  850.                DEC(Place);
  851.                sCursorLeft(1);
  852.              END ELSE BEGIN
  853.                DEC(Place);
  854.                DELETE(tLine,Place,1);
  855.                sCursorLeft(1);
  856.                IF ShowIt THEN sWrite(COPY(tLine,Place,255)+BackSpaceChar)
  857.                          ELSE sWrite(#25'■'+CHAR(LENGTH(COPY(tLine,Place,255)))+BackSpaceChar);
  858.                sCursorLeft(LENGTH(COPY(tLine,Place,255)+BackSpaceChar));
  859.              END;
  860.            END;
  861.       #25: IF tLine[0] <> #0 THEN BEGIN
  862.              sCursorLeft(Place-1);
  863.              sWrite(#25+BackSpaceChar+CHAR(BYTE(tLine[0])));
  864.              sCursorLeft(BYTE(tLine[0]));
  865.              tLine := '';
  866.              Place := 1;
  867.            END;
  868.       #1..#31 : ;
  869.       ELSE BEGIN
  870.         IF (LENGTH(tLine) <> Len) OR ((NOT Insrt) AND (Place-1 <> Len)) THEN BEGIN
  871.           IF Place = LENGTH(tLine)+1 THEN BEGIN
  872.             IF ShowIt THEN sWrite(Ch) ELSE sWrite('■');
  873.             tLine := tLine + Ch;
  874.             INC(Place);
  875.           END ELSE BEGIN
  876.             IF NOT Insrt THEN BEGIN
  877.               IF ShowIt THEN sWrite(Ch) ELSE sWrite('■');
  878.               tLine[Place] := Ch;
  879.               INC(Place);
  880.             END ELSE BEGIN
  881.               INSERT(Ch,tLine,Place);
  882.               IF ShowIt THEN sWrite(COPY(tLine,Place,255))
  883.                         ELSE sWrite(#25'■'+CHAR(LENGTH(COPY(tLine,Place,255))));
  884.               sCursorLeft(LENGTH(COPY(tLine,Place,255))-1);
  885.               INC(Place);
  886.             END;
  887.           END;
  888.         END ELSE BEGIN
  889.           IF NOT WrapInput THEN sWrite(#7)
  890.           ELSE BEGIN
  891.             Temp[0]  := #0;
  892.             RTemp[0] := #0;
  893.             Loop := BYTE(tLine[0]);
  894.             IF POS(#32,tLine) <> 0 THEN BEGIN
  895.               WHILE (tLine[loop] <> #32) DO BEGIN
  896.                 sWrite(#8+BackSpaceChar{+#22#5}); {#22#5 is for Avatar}
  897.                 Temp := Temp + tLine[Loop];
  898.                 DEC(Loop);
  899.                 DEC(tLine[0]);
  900.               END;
  901.               IF Temp[0] <> #0 THEN FOR Loop := BYTE(Temp[0]) DOWNTO 1 DO RTemp := RTemp + Temp[Loop];
  902.             END;
  903.             Ch := #13;
  904.           END;
  905.         END;
  906.       END;
  907.     END;
  908.   UNTIL Ch = #13;
  909.   InputDriver := tLine;
  910.   sWriteln('');
  911. END;
  912. { ────────────────────────────────────────────────────────────────────────── }
  913. FUNCTION SecretInput(Len : BYTE; Default : STRING) : STRING;
  914. BEGIN
  915.   SecretInput := InputDriver(Len,FALSE,FALSE,FALSE,FALSE,Default);
  916. END;
  917. { ────────────────────────────────────────────────────────────────────────── }
  918. FUNCTION NameInput(Len : BYTE; Default : STRING) : STRING;
  919. BEGIN
  920.   NameInput := InputDriver(Len,TRUE,TRUE,FALSE,FALSE,Default);
  921. END;
  922. { ────────────────────────────────────────────────────────────────────────── }
  923. FUNCTION NormalInput(Len : BYTE; Default : STRING) : STRING;
  924. BEGIN
  925.   NormalInput := InputDriver(Len,FALSE,TRUE,FALSE,FALSE,Default);
  926. END;
  927. { ────────────────────────────────────────────────────────────────────────── }
  928. FUNCTION CapsInput(Len : BYTE; Default : STRING) : STRING;
  929. BEGIN
  930.   CapsInput := InputDriver(Len,FALSE,TRUE,TRUE,FALSE,Default);
  931. END;
  932. { ────────────────────────────────────────────────────────────────────────── }
  933. FUNCTION NumberInput(Len : BYTE; Default : STRING) : STRING;
  934. BEGIN
  935.   NumberInput := InputDriver(Len,FALSE,TRUE,FALSE,TRUE,Default);
  936. END;
  937. {───────────────────────────────────────────────────────────────────────────}
  938. FUNCTION NamePrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  939. VAR
  940.   X,Y,Loop : BYTE;
  941. BEGIN
  942.   X := WhereX + 1;
  943.   Y := WhereY;
  944.   BackSpaceChar := '_';
  945.   Set_Color(CS.Bfg,CS.Wbg);
  946.   sWriteC('[');
  947.   Set_Color(CS.Ffg,CS.Fbg);
  948.   sWrite(InStr);
  949.   FOR Loop := LENGTH(InStr) TO (StrLength - 1) DO sWriteC('_');
  950.   Set_Color(CS.Bfg,CS.Wbg);
  951.   sWriteC(']');
  952.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X+LENGTH(InStr),Y);
  953.   Set_Color(CS.Ffg,CS.Fbg);
  954.   NamePrompt := NameInput(StrLength,InStr);
  955.   Set_Color(7,0); {sClrEol};
  956. END;
  957. {───────────────────────────────────────────────────────────────────────────}
  958. FUNCTION NormalPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  959. VAR
  960.   X,Y,Loop : BYTE;
  961. BEGIN
  962.   X := WhereX + 1;
  963.   Y := WhereY;
  964.   BackSpaceChar := '_';
  965.   Set_Color(CS.Bfg,CS.Wbg);
  966.   sWriteC('[');
  967.   Set_Color(CS.Ffg,CS.Fbg);
  968.   sWrite(InStr);
  969.   FOR Loop := LENGTH(InStr) TO (StrLength - 1) DO sWriteC('_');
  970.   Set_Color(CS.Bfg,CS.Wbg);
  971.   sWriteC(']');
  972.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X+LENGTH(InStr),Y);
  973.   Set_Color(CS.Ffg,CS.Fbg);
  974.   NormalPrompt := NormalInput(StrLength,InStr);
  975.   Set_Color(7,0); {sClrEol};
  976. END;
  977. {───────────────────────────────────────────────────────────────────────────}
  978. FUNCTION NumberPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  979. VAR
  980.   X,Y,Loop : BYTE;
  981. BEGIN
  982.   X := WhereX + 1;
  983.   Y := WhereY;
  984.   BackSpaceChar := '_';
  985.   Set_Color(CS.Bfg,CS.Wbg);
  986.   sWriteC('[');
  987.   Set_Color(CS.Ffg,CS.Fbg);
  988.   sWrite(InStr);
  989.   FOR Loop := LENGTH(InStr) TO (StrLength - 1) DO sWriteC('_');
  990.   Set_Color(CS.Bfg,CS.Wbg);
  991.   sWriteC(']');
  992.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X+LENGTH(InStr),Y);
  993.   Set_Color(CS.Ffg,CS.Fbg);
  994.   NumberPrompt := NumberInput(StrLength,InStr);
  995.   Set_Color(7,0); {sClrEol};
  996. END;
  997. {───────────────────────────────────────────────────────────────────────────}
  998. FUNCTION SecretPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  999. VAR
  1000.   X,Y,Loop : BYTE;
  1001. BEGIN
  1002.   X := WhereX + 1;
  1003.   Y := WhereY;
  1004.   BackSpaceChar := '_';
  1005.   Set_Color(CS.Bfg,CS.Wbg);
  1006.   sWriteC('[');
  1007.   Set_Color(CS.Ffg,CS.Fbg);
  1008.   FOR Loop := 1 TO StrLength DO sWriteC('_');
  1009.   Set_Color(CS.Bfg,CS.Wbg);
  1010.   sWriteC(']');
  1011.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X+LENGTH(InStr),Y);
  1012.   Set_Color(CS.Ffg,CS.Fbg);
  1013.   SecretPrompt := SecretInput(StrLength,InStr);
  1014.   Set_Color(7,0); {sClrEol};
  1015. END;
  1016. {───────────────────────────────────────────────────────────────────────────}
  1017. FUNCTION CapsPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  1018. VAR
  1019.   X,Y,Loop : BYTE;
  1020. BEGIN
  1021.   X := WhereX + 1;
  1022.   Y := WhereY;
  1023.   BackSpaceChar := '_';
  1024.   OutTxt(CS.Bfg,CS.Wbg,'[');
  1025.   Set_Color(CS.Ffg,CS.Fbg);
  1026.   InStr := AllCaps(InStr); sWrite(InStr);
  1027.   FOR Loop := LENGTH(InStr) TO (StrLength - 1) DO sWriteC('_');
  1028.   OutTxt(CS.Bfg,CS.Wbg,']');
  1029.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X+LENGTH(InStr),Y);
  1030.   Set_Color(CS.Ffg,CS.Fbg);
  1031.   CapsPrompt := CapsInput(StrLength,InStr);
  1032.   Set_Color(7,0); {sClrEol};
  1033. END;
  1034. {───────────────────────────────────────────────────────────────────────────}
  1035. FUNCTION SysField(X,Y,Style,StrLength : BYTE ; InStr : STRING) : STRING;
  1036. VAR                  {^ 0-Normal 1-Number 2-Name 3-Secret 4-Caps}
  1037.   OldFg,
  1038.   OldBg,
  1039.   OldBr,
  1040.   Loop : BYTE;
  1041. BEGIN
  1042.   sGotoXY(X,Y);
  1043.   OldFg := CS.Ffg;
  1044.   OldBg := CS.Fbg;
  1045.   OldBr := CS.Bfg;
  1046.   CS.Ffg := 15;
  1047.   CS.Fbg := 0;
  1048.   CS.Bfg := 14;
  1049.   CASE Style OF
  1050.     0 : InStr := NormalPrompt(StrLength,InStr);
  1051.     1 : InStr := NumberPrompt(StrLength,InStr);
  1052.     2 : InStr := NamePrompt(StrLength,InStr);
  1053.     3 : InStr := SecretPrompt(StrLength,InStr);
  1054.     4 : InStr := CapsPrompt(StrLength,InStr);
  1055.   END;
  1056.   CS.Ffg := OldFg;
  1057.   CS.Fbg := OldBg;
  1058.   CS.Bfg := OldBr;
  1059.   IF Style <> 3 THEN DummyField(X,Y,StrLength,InStr) ELSE DummyField(X,Y,StrLength,'');
  1060.   SysField := InStr;
  1061.   Set_Color(7,0);
  1062. END;
  1063. {───────────────────────────────────────────────────────────────────────────}
  1064. PROCEDURE DummyField(X,Y,StrLength : BYTE ; InStr : STRING);
  1065. VAR
  1066.   Loop : BYTE;
  1067. BEGIN
  1068.   OutTxtXY(X,Y,CS.Wh,CS.Wbg,' ');
  1069.   OutTxtXY(X+1,Y,7,0,InStr);
  1070.   FOR Loop := LENGTH(InStr) TO (StrLength-1) DO sWriteC('_');
  1071.   OutTxt(CS.Wh,CS.Wbg,' ');
  1072.   Set_Color(7,0);
  1073. END;
  1074. {───────────────────────────────────────────────────────────────────────────}
  1075. PROCEDURE DrawWin(X1,Y1,X2,Y2 : BYTE ; Title : STRING);
  1076. CONST
  1077.   Vs : CHAR = '█';
  1078.   Hs : CHAR = '▀';
  1079.   Tl : CHAR = '┌';
  1080.   Tr : CHAR = '┐';
  1081.   Bl : CHAR = '└';
  1082.   Br : CHAR = '┘';
  1083.   H  : CHAR = '─';
  1084.   V  : CHAR = '│';
  1085. VAR
  1086.   L1,L2 : BYTE;
  1087. BEGIN
  1088.   sGotoXY(X1,Y1);
  1089.   OutTxt(CS.Hfg,CS.Hbg,' ' + Title);
  1090.   FOR L1 := WHEREX TO X2 DO OutTxt(CS.Hfg,CS.Hbg,' ');
  1091.   OutTxtXY(X1,Y1 + 1,CS.Wh,CS.Wbg,Tl);
  1092.   FOR L1 := (X1 + 1) TO (X2 - 1) DO OutTxt(CS.Wh,CS.Wbg,H);
  1093.   OutTxtXY(X2,Y1 + 1,CS.Wl,CS.Wbg,Tr); OutTxt(CS.Sfg,CS.Sbg,Vs);
  1094.   FOR L1 := (Y1 + 2) TO (Y2 - 1) DO BEGIN
  1095.     OutTxtXY(X1,L1,CS.Wh,CS.Wbg,V);
  1096.     FOR L2 := (X1 + 1) TO (X2 - 1) DO OutTxt(CS.Wh,CS.Wbg,' ');
  1097.     OutTxt(CS.Wl,CS.Wbg,V); OutTxt(CS.Sfg,CS.Sbg,Vs);
  1098.   END;
  1099.   OutTxtXY(X1,Y2,CS.Wh,CS.Wbg,Bl);
  1100.   FOR L1 := (X1 + 1) TO (X2 - 1) DO OutTxt(CS.Wl,CS.Wbg,H);
  1101.   OutTxtXY(X2,Y2,CS.Wl,CS.Wbg,Br); OutTxt(CS.Sfg,CS.Sbg,Vs);
  1102.   sGotoXY(X1 + 2,Y2 + 1);
  1103.   FOR L1 := (X1 + 2) TO (X2 + 1) DO OutTxt(CS.Sfg,CS.Sbg,Hs);
  1104.   Set_Color(7,0);
  1105. END;
  1106. {───────────────────────────────────────────────────────────────────────────}
  1107. PROCEDURE ClearWin(X1,Y1,X2,Y2 : BYTE);
  1108. VAR
  1109.   L1,L2 : BYTE;
  1110. BEGIN
  1111.   FOR L1 := Y1 TO Y2 DO BEGIN
  1112.     sGotoXY(X1,L1);
  1113.     FOR L2 := X1 TO X2 DO OutTxt(CS.Wh,CS.Wbg,' ');
  1114.   END;
  1115.   Set_Color(7,0);
  1116. END;
  1117. {───────────────────────────────────────────────────────────────────────────}
  1118. PROCEDURE DrawButton(HotKey : CHAR ; Txt : STRING ; HighLight : BOOLEAN);
  1119. VAR
  1120.   BL,BR : CHAR;
  1121.   FG    : BYTE;
  1122. BEGIN
  1123.   BR := '▌'; BL := '▐';
  1124.   OutTxt(8,0,BL);
  1125.   IF HighLight THEN FG := 1 ELSE FG := 8;
  1126.   IF HighLight THEN OutTxt(4,7,' ' + HotKey);
  1127.   IF NOT HighLight THEN OutTxt(8,7,' ' + HotKey);
  1128.   OutTxt(FG,7,Txt + ' ');
  1129.   OutTxt(8,0,BR);
  1130. END;
  1131. {───────────────────────────────────────────────────────────────────────────}
  1132. PROCEDURE SysButton(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  1133. VAR
  1134.   L1,Sfg,Sbg : BYTE;
  1135.   Vs,Hs      : CHAR;
  1136. BEGIN
  1137.   Vs := '▄';
  1138.   Hs := '▀';
  1139.   OutTxtXY(X,Y,4,7,' ' + HotKey);
  1140.   OutTxt(0,7,Txt + ' ');
  1141.   OutTxt(0,CS.Wbg,Vs);
  1142.   sGotoXY(X + 1,Y + 1);
  1143.   FOR L1 := 1 TO (LENGTH(Txt) + 3) DO OutTxt(0,CS.Wbg,Hs);
  1144.   Set_Color(7,0);
  1145. END;
  1146. {───────────────────────────────────────────────────────────────────────────}
  1147. PROCEDURE DrawMenu(X1,Y1,X2,Y2 : BYTE);
  1148. CONST
  1149.   Vs : CHAR = '█';
  1150.   Hs : CHAR = '▀';
  1151.   Tl : CHAR = '┌';
  1152.   Tr : CHAR = '┐';
  1153.   Bl : CHAR = '└';
  1154.   Br : CHAR = '┘';
  1155.   H  : CHAR = '─';
  1156.   V  : CHAR = '│';
  1157. VAR
  1158.   L1,L2 : BYTE;
  1159. BEGIN
  1160.   sGotoXY(X1,Y1);
  1161.   OutTxtXY(X1,Y1,0,7,Tl);
  1162.   FOR L1 := (X1 + 1) TO (X2 - 1) DO OutTxt(0,7,H);
  1163.   OutTxtXY(X2,Y1,0,7,Tr);
  1164.   FOR L1 := (Y1 + 1) TO (Y2 - 1) DO BEGIN
  1165.     OutTxtXY(X1,L1,0,7,V);
  1166.     FOR L2 := (X1 + 1) TO (X2 - 1) DO OutTxt(0,7,' ');
  1167.     OutTxt(0,7,V);
  1168.     OutTxt(CS.Sfg,CS.Sbg,Vs);
  1169.   END;
  1170.   OutTxtXY(X1,Y2,0,7,Bl);
  1171.   FOR L1 := (X1 + 1) TO (X2 - 1) DO OutTxt(0,7,H);
  1172.   OutTxtXY(X2,Y2,0,7,Br); OutTxt(CS.Sfg,CS.Sbg,Vs);
  1173.   Set_Color(CS.Sfg,CS.Sbg);
  1174.   sGotoXY(X1+2,Y2+1);
  1175.   FOR L1 := (X1 + 2) TO (X2 + 1) DO sWriteC(Hs);
  1176.   Set_Color(7,0);
  1177. END;
  1178. {───────────────────────────────────────────────────────────────────────────}
  1179. PROCEDURE MenuItem(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  1180. BEGIN
  1181.   OutTxtXY(X,Y,1,7,HotKey);
  1182.   OutTxt(0,7,Txt);
  1183.   Set_Color(7,0);
  1184. END;
  1185. {───────────────────────────────────────────────────────────────────────────}
  1186. PROCEDURE MenuLine(X,Y,L : BYTE);
  1187. VAR
  1188.   Loop : BYTE;
  1189. BEGIN
  1190.   OutTxtXY(X,Y,0,7,'├');
  1191.   FOR Loop := 1 TO (L - 2) DO OutTxt(0,7,'─');
  1192.   OutTxt(0,7,'┤');
  1193.   Set_Color(7,0);
  1194. END;
  1195. {───────────────────────────────────────────────────────────────────────────}
  1196. PROCEDURE MenuBarItem(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  1197. BEGIN
  1198.    OutTxtXY(X,Y,4,7,HotKey);
  1199.    OutTxt(0,7,Txt);
  1200.    Set_Color(7,0);
  1201. END;
  1202. {───────────────────────────────────────────────────────────────────────────}
  1203. PROCEDURE InfoBox(Width : BYTE ; Height : BYTE);
  1204. CONST
  1205.   LTC  : CHAR = '╔';
  1206.   RTC  : CHAR = '╗';
  1207.   LBC  : CHAR = '╚';
  1208.   RBC  : CHAR = '╝';
  1209.   HBAR : CHAR = '═';
  1210.   VBAR : CHAR = '║';
  1211. VAR
  1212.   Row,Loop : BYTE;
  1213. BEGIN
  1214.   Row := WhereY;
  1215.   Set_Color(9,0);
  1216.   sGotoXY(1,Row); sWriteC(LTC);
  1217.   FOR Loop := 2 TO (Width-1) DO sWriteC(HBAR);
  1218.   Set_Color(1,0); sWritelnC(RTC);
  1219.   Row := WhereY;
  1220.   FOR Loop := 1 TO Height DO BEGIN
  1221.     Set_Color(9,0);
  1222.     sGotoXY(1,Row); sWriteC(VBAR);
  1223.     Set_Color(1,0);
  1224.     sGotoXY(Width,Row); sWritelnC(VBAR);
  1225.     Row := WhereY;
  1226.   END;
  1227.   Set_Color(9,0);
  1228.   sWriteC(LBC);
  1229.   Set_Color(1,0);
  1230.   FOR Loop := 2 TO (Width-1) DO sWriteC(HBAR);
  1231.   sGotoXY(Width,Row); sWritelnC(RBC);
  1232. END;
  1233. {───────────────────────────────────────────────────────────────────────────}
  1234. PROCEDURE InfoText(Txt : STRING);
  1235. VAR
  1236.   LB,RB : STRING[4];
  1237. BEGIN
  1238.   LB := '░▒▓█';
  1239.   RB := '█▓▒░';
  1240.   Set_Color(1,0);  sWrite(LB);
  1241.   Set_Color(15,1); sWrite(Txt);
  1242.   Set_Color(1,0);  sWrite(RB);
  1243. END;
  1244. {───────────────────────────────────────────────────────────────────────────}
  1245. PROCEDURE LineBar(FG,BG,L : BYTE);
  1246. VAR
  1247.   Loop : BYTE;
  1248. BEGIN
  1249.   Set_Color(FG,BG);
  1250.   FOR Loop := 1 TO L DO sWriteC('─');
  1251.   sWriteln('');
  1252. END;
  1253. {───────────────────────────────────────────────────────────────────────────}
  1254. PROCEDURE RunEntryForm(ScriptFile : STRING);
  1255. TYPE EntryFields = ARRAY[1..50] OF STRING;
  1256. VAR
  1257.   Go1,
  1258.   Go2,Go3,
  1259.   GotText : BOOLEAN;
  1260.   OldGfx,
  1261.   Loop,FC : BYTE;
  1262.   Scrn,
  1263.   InFile,
  1264.   OutFile : Text;
  1265.   Cmd,
  1266.   V1,V2,
  1267.   ScrLine : STRING;
  1268.   _Field  : ^EntryFields;
  1269. BEGIN
  1270.   IF NOT FExist(ScriptFile) THEN EXIT;
  1271.   NEW(_Field);
  1272.   sClrScr;
  1273.   GotText := FALSE; FC := 0;
  1274.   ASSIGN(InFile,ScriptFile);
  1275.   RESET(InFile);
  1276.   WHILE NOT EOF(InFile) DO BEGIN
  1277.     Go1 := TRUE; Go2 := FALSE; Go3 := FALSE;
  1278.     Cmd := ''; V1 := ''; V2 := '';
  1279.     READLN(InFile,ScrLine);
  1280.     ScrLine := CvtVars(ScrLine);
  1281.     FOR Loop := 1 TO LENGTH(ScrLine) DO BEGIN
  1282.       IF (Go2) AND (ScrLine[Loop] = '@') THEN BEGIN
  1283.         Go1 := FALSE;
  1284.         Go2 := FALSE;
  1285.         Go3 := TRUE;
  1286.       END;
  1287.       IF Go1 THEN Cmd := Cmd + ScrLine[Loop];
  1288.       IF Go2 THEN V1 := V1 + ScrLine[Loop];
  1289.       IF (Go3) AND (ScrLine[Loop] <> '@') THEN V2 := V2 + ScrLine[Loop];
  1290.       IF (Go1) AND (ScrLine[Loop] = '@') THEN BEGIN
  1291.         Go1 := FALSE;
  1292.         Go2 := TRUE;
  1293.         Go3 := FALSE;
  1294.       END;
  1295.     END;
  1296.     Cmd := AllCaps(Cmd);
  1297.     IF Cmd = 'SCREENFILE@' THEN BEGIN
  1298.       V1 := AllCaps(V1);
  1299.       OldGfx := Graphics;
  1300.       CASE Graphics OF
  1301.         RIP  : IF FExist(V1 + '.RIP') THEN ShowScreen(V1 + '.RIP')
  1302.                ELSE BEGIN
  1303.                  RipToText;
  1304.                  Graphics := ANSI;
  1305.                END;
  1306.         ANSI : IF FExist(V1 + '.ANS') THEN ShowScreen(V1 + '.ANS')
  1307.                                       ELSE Graphics := TTY;
  1308.         TTY  : ShowScreen(V1 + '.ASC');
  1309.       END;
  1310.       sWriteln('');
  1311.       Graphics := OldGfx;
  1312.     END;
  1313.     IF (Cmd = 'TEXTFILE@') AND (NOT GotText) THEN BEGIN
  1314.       GotText := TRUE;
  1315.       V1 := AllCaps(V1);
  1316.       ASSIGN(OutFile,V1);
  1317.       IF NOT FExist(V1) THEN REWRITE(OutFile) ELSE APPEND(OutFile);
  1318.     END;
  1319.     IF Cmd = 'PROMPTTEXT@' THEN BEGIN
  1320.       Set_Color(CS.CPTfg,CS.CPTbg);
  1321.       CvtColors(V1,FALSE);
  1322.     END;
  1323.     IF Cmd = 'LINEFEED@' THEN sWriteln('');
  1324.     IF Cmd = 'ANYKEY@' THEN AnyKey;
  1325.     IF Cmd = 'PROPERPROMPT@' THEN BEGIN
  1326.       INC(FC); sWriteC(' ');
  1327.       IF Graphics = TTY THEN _Field^[FC] := NameInput(StrToInt(V1),V2)
  1328.                         ELSE _Field^[FC] := NamePrompt(StrToInt(V1),V2);
  1329.     END;
  1330.     IF Cmd = 'NORMALPROMPT@' THEN BEGIN
  1331.       INC(FC); sWriteC(' ');
  1332.       IF Graphics = TTY THEN _Field^[FC] := NormalInput(StrToInt(V1),V2)
  1333.                         ELSE _Field^[FC] := NormalPrompt(StrToInt(V1),V2);
  1334.     END;
  1335.     IF Cmd = 'NUMBERPROMPT@' THEN BEGIN
  1336.       INC(FC); sWriteC(' ');
  1337.       IF Graphics = TTY THEN _Field^[FC] := NumberInput(StrToInt(V1),V2)
  1338.                         ELSE _Field^[FC] := NumberPrompt(StrToInt(V1),V2);
  1339.     END;
  1340.     IF Cmd = 'CAPITALPROMPT@' THEN BEGIN
  1341.       INC(FC); sWriteC(' ');
  1342.       IF Graphics = TTY THEN _Field^[FC] := CapsInput(StrToInt(V1),V2)
  1343.                         ELSE _Field^[FC] := CapsPrompt(StrToInt(V1),V2);
  1344.     END;
  1345.     IF Cmd = 'HIDDENPROMPT@' THEN BEGIN
  1346.       INC(FC); sWriteC(' ');
  1347.       IF Graphics = TTY THEN _Field^[FC] := SecretInput(StrToInt(V1),V2)
  1348.                         ELSE _Field^[FC] := SecretPrompt(StrToInt(V1),V2);
  1349.     END;
  1350.     IF Cmd = 'OUTTEXT@' THEN BEGIN
  1351.       IF V2 <> '' THEN WRITE(OutFile,V1)
  1352.                   ELSE WRITELN(OutFile,V1);
  1353.       IF (V2 <> '') AND (StrToInt(V2) <= FC) THEN WRITELN(OutFile,_Field^[StrToInt(V2)]);
  1354.     END;
  1355.     IF Cmd = 'RUNBATCHFILE@' THEN RunBatFile(V1);
  1356.     IF Cmd = 'SHOWTEXTFILE@' THEN ShowTextFile(V1);
  1357.     IF Cmd = 'CLS@' THEN sClrScr;
  1358.   END;
  1359.   DISPOSE(_Field);
  1360.   IF GotText THEN CLOSE(OutFile);
  1361.   CLOSE(InFile);
  1362. END;
  1363. {───────────────────────────────────────────────────────────────────────────}
  1364. PROCEDURE Log(LogLine : STRING);
  1365. VAR
  1366.   TheLog : Text;
  1367. BEGIN
  1368.   IF (NOT UseLog) Or (LogFile = '') THEN EXIT;
  1369.   ASSIGN(TheLog,LogPath+LogFile);
  1370.   IF NOT FExist(LogPath+LogFile) THEN BEGIN
  1371.     REWRITE(TheLog);
  1372.     CLOSE(TheLog);
  1373.   END;
  1374.   APPEND(TheLog);
  1375.   IF (LogLine = 'BEGIN') AND (NOT Shotgun) THEN BEGIN
  1376.     WRITELN(TheLog,'───────────────────────────────────────────────────────────────────────────────');
  1377.     WRITELN(TheLog,' Activity Log Created By: '+ProgramName);
  1378.     WRITELN(TheLog,'──────────┬────────────────────────────────────────────────────────────────────');
  1379.   END;
  1380.   IF (LogLine <> 'BEGIN') AND (LogLine <> 'END') THEN WRITELN(TheLog,'  '+TimeVariable+' │  '+LogLine);
  1381.   IF (LogLine = 'END') AND (NOT Shotgun) THEN
  1382.      WRITELN(TheLog,'──────────┴────────────────────────────────────────────────────────────────────');
  1383.   CLOSE(TheLog);
  1384. END;
  1385. {───────────────────────────────────────────────────────────────────────────}
  1386. PROCEDURE Terminate(S : STRING);
  1387. BEGIN
  1388.   TextAttr := 7;
  1389.   CLRSCR;
  1390.   TextAttr := 12;
  1391.   WRITELN(S);
  1392.   AlertTones;
  1393.   TextAttr := 7;
  1394.   DELAY(1000);
  1395.   HALT(ErrLevel);
  1396. END;
  1397. {───────────────────────────────────────────────────────────────────────────}
  1398. PROCEDURE ErrorLog(LogLine : STRING ; ELevel : BYTE ; BailOut : BOOLEAN);
  1399. VAR
  1400.   LogFile : Text;
  1401. BEGIN
  1402.   ASSIGN(LogFile,LogPath+'ERROR.LOG');
  1403.   IF NOT FExist(LogPath+'ERROR.LOG') THEN BEGIN
  1404.     REWRITE(LogFile);
  1405.     WRITELN(LogFile,' Error Log Created By: '+ProgramName);
  1406.     WRITELN(LogFile,'──────────┬────────────────────────────────────────────────────────────────────');
  1407.     CLOSE(LogFile);
  1408.   END;
  1409.   APPEND(LogFile);
  1410.   WRITELN(LogFile,'  '+TimeVariable+' │  '+LogLine);
  1411.   IF BailOut THEN WRITELN(LogFile,'  '+TimeVariable+' │  Exiting At ErrorLevel '+IntToStr(ELevel));
  1412.   CLOSE(LogFile);
  1413.   ErrLevel := ELevel;
  1414.   IF BailOut THEN Terminate(LogLine);
  1415. END;
  1416. {───────────────────────────────────────────────────────────────────────────}
  1417. FUNCTION GoodColor(TempStr : STRING) : BOOLEAN;
  1418. VAR
  1419.   FG : BYTE;
  1420. BEGIN
  1421.   FG := 50;
  1422.   IF TempStr = '{0}'  THEN FG := 0;
  1423.   IF TempStr = '{1}'  THEN FG := 1;
  1424.   IF TempStr = '{2}'  THEN FG := 2;
  1425.   IF TempStr = '{3}'  THEN FG := 3;
  1426.   IF TempStr = '{4}'  THEN FG := 4;
  1427.   IF TempStr = '{5}'  THEN FG := 5;
  1428.   IF TempStr = '{6}'  THEN FG := 6;
  1429.   IF TempStr = '{7}'  THEN FG := 7;
  1430.   IF TempStr = '{8}'  THEN FG := 8;
  1431.   IF TempStr = '{9}'  THEN FG := 9;
  1432.   IF TempStr = '{10}' THEN FG := 10;
  1433.   IF TempStr = '{11}' THEN FG := 11;
  1434.   IF TempStr = '{12}' THEN FG := 12;
  1435.   IF TempStr = '{13}' THEN FG := 13;
  1436.   IF TempStr = '{14}' THEN FG := 14;
  1437.   IF TempStr = '{15}' THEN FG := 15;
  1438.   IF TempStr = '{16}' THEN FG := 16;
  1439.   IF TempStr = '{17}' THEN FG := 17;
  1440.   IF TempStr = '{18}' THEN FG := 18;
  1441.   IF TempStr = '{19}' THEN FG := 19;
  1442.   IF TempStr = '{20}' THEN FG := 20;
  1443.   IF TempStr = '{21}' THEN FG := 21;
  1444.   IF TempStr = '{22}' THEN FG := 22;
  1445.   IF TempStr = '{23}' THEN FG := 23;
  1446.   IF TempStr = '{24}' THEN FG := 24;
  1447.   IF TempStr = '{25}' THEN FG := 25;
  1448.   IF TempStr = '{26}' THEN FG := 26;
  1449.   IF TempStr = '{27}' THEN FG := 27;
  1450.   IF TempStr = '{28}' THEN FG := 28;
  1451.   IF TempStr = '{29}' THEN FG := 29;
  1452.   IF TempStr = '{30}' THEN FG := 30;
  1453.   IF TempStr = '{31}' THEN FG := 31;
  1454.   IF FG <> 50 THEN BEGIN
  1455.     SetFore(FG);
  1456.     GoodColor := TRUE;
  1457.   END ELSE GoodColor := FALSE;
  1458. END;
  1459. {───────────────────────────────────────────────────────────────────────────}
  1460. PROCEDURE CvtColors(InStr : STRING ; LF : BOOLEAN);
  1461. VAR
  1462.   Loop : BYTE;
  1463.   Cvt  : BOOLEAN;
  1464.   Temp : STRING;
  1465. BEGIN
  1466.   Cvt  := FALSE;
  1467.   Temp := '';
  1468.   FOR Loop := 1 TO LENGTH(InStr) DO BEGIN
  1469.     IF InStr[Loop] = '{' THEN Cvt := TRUE;
  1470.     IF NOT Cvt THEN sWriteC(InStr[Loop]);
  1471.     IF Cvt THEN Temp := Temp + InStr[Loop];
  1472.     IF (Cvt) AND (InStr[Loop] = '}') THEN BEGIN
  1473.       IF NOT GoodColor(Temp) THEN sWrite(Temp);
  1474.       Cvt := FALSE;
  1475.       Temp := '';
  1476.     END;
  1477.   END;
  1478.   IF LF THEN sWriteln('');
  1479. END;
  1480. {───────────────────────────────────────────────────────────────────────────}
  1481. FUNCTION CvtVars(Txt : STRING) : STRING;
  1482. VAR
  1483.   Cvt  : BOOLEAN;
  1484.   Loop : BYTE;
  1485.   Parm,
  1486.   Temp : STRING;
  1487. BEGIN
  1488.   Cvt := FALSE; Parm := ''; Temp := '';
  1489.   FOR Loop := 1 TO LENGTH(Txt) DO BEGIN
  1490.     IF Txt[Loop] = '{' THEN Cvt := TRUE;
  1491.     IF NOT Cvt THEN Parm := Parm + Txt[Loop];
  1492.     IF Cvt THEN Temp := Temp + Txt[Loop];
  1493.     IF Txt[Loop] = '}' THEN BEGIN
  1494.       IF Temp = '{TIME}'     THEN Temp := TimeVariable;
  1495.       IF Temp = '{DATE}'     THEN Temp := DateVariable;
  1496.       IF Temp = '{NODE}'     THEN Temp := IntToStr(DoorSys.Node);
  1497.       IF Temp = '{BAUD}'     THEN Temp := IntToStr(DoorSys.BaudRate);
  1498.       IF Temp = '{MINS}'     THEN Temp := IntToStr(DoorSys.SecondsLeft DIV 60);
  1499.       IF Temp = '{EVENT}'    THEN Temp := IntToStr(DoorSys.Event);
  1500.       IF Temp = '{PORT}'     THEN Temp := IntToStr(DoorSys.Comport);
  1501.       IF Temp = '{SEC}'      THEN Temp := IntToStr(DoorSys.Access);
  1502.       IF Temp = '{BBS}'      THEN Temp := Ctl.BBSname;
  1503.       IF Temp = '{USER}'     THEN Temp := DoorSys.UserName;
  1504.       IF Temp = '{USER#}'    THEN Temp := IntToStr(DoorSys.UserNumber);
  1505.       IF Temp = '{SYSOP}'    THEN Temp := Ctl.SFirst+' '+Ctl.SLast;
  1506.       IF Temp = '{UFIRST}'   THEN Temp := UFirst;
  1507.       IF Temp = '{ULAST}'    THEN Temp := ULast;
  1508.       IF Temp = '{SFIRST}'   THEN Temp := Ctl.SFirst;
  1509.       IF Temp = '{SLAST}'    THEN Temp := Ctl.SLast;
  1510.       IF Temp = '{PROG}'     THEN Temp := ProgramName;
  1511.       IF Temp = '{ADDR}'     THEN Temp := Ctl.HexAddr;
  1512.       IF Temp = '{IRQ}'      THEN Temp := IntToStr(Ctl.IRQ);
  1513.       IF Temp = '{SYSSEC}'   THEN Temp := IntToStr(Ctl.SysSec);
  1514.       IF Temp = '{SERIAL}'   THEN Temp := Ctl.SerialNumber;
  1515.       IF Temp = '{INSERT1}'  THEN Temp := Insert1;
  1516.       IF Temp = '{INSERT2}'  THEN Temp := Insert2;
  1517.       IF Temp = '{INSERT3}'  THEN Temp := Insert3;
  1518.       IF Temp = '{INSERT4}'  THEN Temp := Insert4;
  1519.       IF Temp = '{INSERT5}'  THEN Temp := Insert5;
  1520.       Parm := Parm + Temp;
  1521.       Temp := '';
  1522.       Cvt  := FALSE;
  1523.     END;
  1524.   END;
  1525.   IF (Cvt) AND (Loop = LENGTH(Txt)) THEN Parm := Parm + Temp;
  1526.   CvtVars := Parm;
  1527. END;
  1528. {───────────────────────────────────────────────────────────────────────────}
  1529. FUNCTION DateVariable : STRING;
  1530. VAR
  1531.   Mo,
  1532.   Da,Yr      : STRING[4];
  1533.   Year,Month,
  1534.   Day,Dow    : WORD;
  1535. BEGIN
  1536.   GETDATE(Year,Month,Day,Dow);
  1537.   STR(Year,Yr); DELETE(Yr,1,2);
  1538.   STR(Month,Mo);
  1539.   IF Month < 10 THEN Mo := '0' + Mo;
  1540.   STR(Day,Da);
  1541.   IF Day < 10   THEN Da := '0' + Da;
  1542.   DateVariable := Mo + '/' + Da + '/' + Yr;
  1543. END;
  1544. {───────────────────────────────────────────────────────────────────────────}
  1545. FUNCTION TimeVariable : STRING;
  1546. VAR
  1547.   TStr,
  1548.   Hr,Mn      : STRING[2];
  1549.   Hour,Min,
  1550.   Sec,Sec100 : WORD;
  1551. BEGIN
  1552.   GETTIME(Hour,Min,Sec,Sec100);
  1553.   IF Hour < 12 THEN TStr := 'am' ELSE TStr := 'pm';
  1554.   IF Hour = 0  THEN Hour := 12;
  1555.   IF Hour > 12 THEN Hour := Hour - 12;
  1556.   STR(Hour,Hr);
  1557.   STR(Min,Mn);
  1558.   IF Min < 10  THEN Mn := '0' + Mn;
  1559.   IF Min = 0   THEN Mn := '00';
  1560.   IF Hour < 10 THEN Hr := ' ' + Hr;
  1561.   TimeVariable := Hr + ':' + Mn + TStr;
  1562. END;
  1563. {───────────────────────────────────────────────────────────────────────────}
  1564. PROCEDURE RipToText;
  1565. BEGIN
  1566.   Set_Color(0,0);
  1567.   sClrScr;
  1568.   sWriteln(#13#10);
  1569.   sWriteln('!|1K|*|#|#|#'+#13);
  1570.   Set_Color(7,0);
  1571. END;
  1572. {───────────────────────────────────────────────────────────────────────────}
  1573. PROCEDURE ShowTextFile(TextFile : STRING);
  1574. TYPE TextData = RECORD
  1575.      TLine    : STRING[128];
  1576.      END;
  1577. VAR
  1578.   T         : TextData;
  1579.   TDat      : FILE OF TextData;
  1580.   Ch        : CHAR;
  1581.   Count     : BYTE;
  1582.   Loop,Cnt  : INTEGER;
  1583.   File_Name : Text;
  1584. BEGIN;
  1585.   IF Graphics = RIP THEN RipToText;
  1586.   sClrScr;
  1587.   ASSIGN(File_Name,TextFile);
  1588.   ASSIGN(TDat,GetFilePath(TextFile)+'TEXT'+IntToStr(DoorSys.Node)+'.DAT');
  1589.   IF NOT FExist(TextFile) THEN EXIT;
  1590.   RESET(File_Name);
  1591.   REWRITE(TDat);
  1592.   Cnt := 0;
  1593.   WHILE NOT EOF (File_Name) DO BEGIN
  1594.     READLN(File_Name,T.TLine);
  1595.     FOR Count := 1 TO LENGTH(T.TLine) DO IF T.TLine[Count] = ' ' THEN T.TLine[Count] := ' ';
  1596.     T.TLine := CvtVars(T.TLine);
  1597.     SEEK(TDat,Cnt);
  1598.     WRITE(TDat,T);
  1599.     INC(Cnt);
  1600.   END;
  1601.   DEC(Cnt);
  1602.   CLOSE(File_Name);
  1603.   RESET(TDat);
  1604.   Count := 1;
  1605.   FOR Loop := 0 TO Cnt DO BEGIN
  1606.     SEEK(TDat,Loop);
  1607.     READ(TDat,T);
  1608.     Set_Color(CS.TxFG,CS.TxBG);
  1609.     CvtColors(T.TLine,TRUE);
  1610.     INC(Count);
  1611.     IF (Count = 22) OR (Loop = Cnt) THEN BEGIN
  1612.       LineBar(1,0,79);
  1613.       CPrompt('Q','uit'); CPrompt('T','op'); CPrompt('B','ottom'); CPrompt('P','revious'); CPrompt('N','ext');
  1614.       Ch := UPCASE(sReadKey);
  1615.       CASE Ch OF
  1616.         'Q' : BEGIN
  1617.                 CLOSE(TDat);
  1618.                 ERASE(TDat);
  1619.                 EXIT;
  1620.               END;
  1621.         'T' : Loop := 0 - 1;
  1622.         'B' : Loop := Cnt - 21;
  1623.         'P' : BEGIN
  1624.                 DEC(Loop,45);
  1625.                 IF Loop < 0 THEN Loop := 0 - 1;
  1626.               END;
  1627.       END;
  1628.       Count := 1;
  1629.       IF Loop <> Cnt THEN sClrScr;
  1630.     END;
  1631.   END;
  1632.   CLOSE(TDat);
  1633.   ERASE(TDat);
  1634. END;
  1635. {───────────────────────────────────────────────────────────────────────────}
  1636. PROCEDURE ShowScreen(Scr : STRING);
  1637. VAR
  1638.   LN        : STRING;
  1639.   File_Name : Text;
  1640. BEGIN;
  1641.   IF NOT FExist(Scr) THEN EXIT;
  1642.   IF Graphics = RIP THEN BEGIN
  1643.     Set_Color(0,0);
  1644.     sWriteln(#13#10);
  1645.     sWriteln(#12#13);
  1646.   END;
  1647.   ASSIGN(File_Name,Scr);
  1648.   RESET(File_Name);
  1649.   HideCursor;
  1650.   WHILE NOT EOF(File_Name) DO BEGIN
  1651.     READLN(File_Name,LN);
  1652.     LN := CvtVars(LN);
  1653.     CASE Graphics OF
  1654.       MAX  : SendStr(LN);
  1655.       RIP  : SendStr(LN);
  1656.       ANSI : BEGIN
  1657.                SendStr(LN);
  1658.                AnsiWriteln(LN);
  1659.              END;
  1660.       TTY  : sWriteln(LN);
  1661.     END;
  1662.   END;
  1663.   ShowCursor;
  1664.   CLOSE(File_Name);
  1665.   CASE Graphics OF
  1666.     RIP : DVWrite(1,2,15,'Displaying RIP File: '+PadRight(Scr,' ',12));
  1667.     MAX : DVWrite(1,2,15,'Displaying MAX File: '+PadRight(Scr,' ',12));
  1668.   END;
  1669.   IF Graphics <> TTY THEN sGotoXY(VirtX,VirtY);
  1670.   Set_Color(7,0); sClrEol;
  1671. END;
  1672. {───────────────────────────────────────────────────────────────────────────}
  1673. PROCEDURE FullScreenChat;
  1674. VAR
  1675.   FG,
  1676.   Loop,
  1677.   UserX,
  1678.   UserY,
  1679.   SysopX,
  1680.   SysopY   : BYTE;
  1681.   Quit     : BOOLEAN;
  1682.   Ch       : CHAR;
  1683.   Temp     : STRING;
  1684. BEGIN
  1685.   DoorSys.UpdateSecs := FALSE;
  1686.   DoorSys.UpdateIdle := FALSE;
  1687.   sClrScr;
  1688.   InfoText(Center(ProgramName,71));
  1689.   sGotoXY(1,2); InfoBox(79,8);
  1690.   InfoText(Center(ProgramDesc,71));
  1691.   sGotoXY(1,13); InfoBox(79,8);
  1692.   InfoText('CTRL-W (Clear Window)                               CTRL-Y (Clear Line)');
  1693.   DVWrite(1,24,8,Center('Press The ESCape Key To Terminate Chat Mode!',79));
  1694.   OutTxtXY(3,2,10,0,' ' + #31 + ' ' + Ctl.SFirst + ' ' + Ctl.SLast + ' ' + #31 + ' ');
  1695.   OutTxtXY(3,13,14,0,' ' + #31 + ' ' + DoorSys.UserName + ' ' + #31 + ' ');
  1696.   SysopX    := 2;
  1697.   SysopY    := 3;
  1698.   UserX     := 2;
  1699.   UserY     := 14;
  1700.   Quit      := FALSE;
  1701.   sGotoXY(2,3);
  1702.   IF Local THEN DoorSys.LocalKey := TRUE;
  1703.   REPEAT
  1704.     REPEAT
  1705.       Ch := sReadKey;
  1706.     UNTIL Ch IN [#0,#8,#13,#23,#25,#27,' '..#255];
  1707.     CASE Ch OF
  1708.       'A'..'Z' : FG := 15;
  1709.       'a'..'z' : FG := 11;
  1710.       #0 : BEGIN
  1711.             sReadKey;
  1712.             Ch := #0;
  1713.           END;
  1714.       #8 : IF DoorSys.LocalKey THEN BEGIN
  1715.              DEC(SysopX);
  1716.              IF SysopX < 2 THEN SysopX := 2;
  1717.              Ch := #0;
  1718.              OutTxtXY(SysopX,SysopY,10,0,' ');
  1719.              sGotoXY(SysopX,SysopY);
  1720.            END ELSE BEGIN
  1721.              DEC(UserX);
  1722.              IF UserX < 2 THEN UserX := 2;
  1723.              Ch := #0;
  1724.              OutTxtXY(UserX,UserY,14,0,' ');
  1725.              sGotoXY(UserX,UserY);
  1726.            END;
  1727.       #13 : IF DoorSys.LocalKey THEN BEGIN
  1728.              SysopX := 2;
  1729.              INC(SysopY);
  1730.              IF SysopY > 10 THEN SysopY := 3;
  1731.              sGotoXY(SysopX,SysopY);
  1732.              sWrite(PadRight(' ',' ',77));
  1733.              IF SysopY < 10 THEN sGotoXY(SysopX,SysopY + 1) ELSE sGotoXY(SysopX,3);
  1734.              sWrite(PadRight(' ',' ',77));
  1735.              sGotoXY(SysopX,SysopY);
  1736.              Ch := #0;
  1737.            END ELSE BEGIN
  1738.              UserX := 2;
  1739.              INC(UserY);
  1740.              IF UserY > 21 THEN UserY := 14;
  1741.              sGotoXY(UserX,UserY);
  1742.              sWrite(PadRight(' ',' ',77));
  1743.              IF UserY < 21 THEN sGotoXY(UserX,UserY + 1) ELSE sGotoXY(UserX,14);
  1744.              sWrite(PadRight(' ',' ',77));
  1745.              sGotoXY(UserX,UserY);
  1746.              Ch := #0;
  1747.            END;
  1748.       #23 : IF DoorSys.LocalKey THEN BEGIN
  1749.              FOR Loop := 3 TO 10 DO OutTxtXY(2,Loop,7,0,PadRight(' ',' ',77));
  1750.              SysopX := 2;
  1751.              SysopY := 3;
  1752.              sGotoXY(SysopX,SysopY);
  1753.              Ch := #0;
  1754.            END ELSE BEGIN
  1755.              FOR Loop := 14 TO 21 DO OutTxtXY(2,Loop,7,0,PadRight(' ',' ',77));
  1756.              UserX := 2;
  1757.              UserY := 14;
  1758.              sGotoXY(UserX,UserY);
  1759.              Ch := #0;
  1760.            END;
  1761.       #25 : IF DoorSys.LocalKey THEN BEGIN
  1762.              SysopX := 2;
  1763.              sGotoXY(SysopX,SysopY);
  1764.              sWrite(PadRight(' ',' ',77));
  1765.              sGotoXY(SysopX,SysopY);
  1766.              Ch := #0;
  1767.            END ELSE BEGIN
  1768.              UserX := 2;
  1769.              sGotoXY(UserX,UserY);
  1770.              sWrite(PadRight(' ',' ',77));
  1771.              sGotoXY(UserX,UserY);
  1772.              Ch := #0;
  1773.            END;
  1774.       #27 : IF NOT DoorSys.LocalKey THEN BEGIN
  1775.              DELAY(50);
  1776.              WHILE sKeyPressed DO sReadKey;
  1777.              Ch := #0;
  1778.            END;
  1779.       ELSE FG := 9;
  1780.     END;
  1781.     Quit := Ch = #27;
  1782.     IF (NOT Quit) AND (Ch <> #0) AND (Ch <> #27) THEN BEGIN
  1783.       IF DoorSys.LocalKey THEN BEGIN
  1784.         OutTxtXY(SysopX,SysopY,FG,0,Ch);
  1785.         INC(SysopX);
  1786.         IF SysopX = 79 THEN BEGIN
  1787.           SysopX := 2;
  1788.           INC(SysopY);
  1789.           IF SysopY > 10 THEN SysopY := 3;
  1790.           sGotoXY(SysopX,SysopY);
  1791.           sWrite(PadRight(' ',' ',77));
  1792.           IF SysopY < 10 THEN sGotoXY(SysopX,SysopY + 1) ELSE sGotoXY(SysopX,3);
  1793.           sWrite(PadRight(' ',' ',77));
  1794.         END;
  1795.         sGotoXY(SysopX,SysopY);
  1796.       END ELSE BEGIN
  1797.         OutTxtXY(UserX,UserY,FG,0,Ch);
  1798.         INC(UserX);
  1799.         IF UserX = 79 THEN BEGIN
  1800.           UserX := 2;
  1801.           INC(UserY);
  1802.           IF UserY > 21 THEN UserY := 14;
  1803.           sGotoXY(UserX,UserY);
  1804.           sWrite(PadRight(' ',' ',77));
  1805.           IF UserY < 21 THEN sGotoXY(UserX,UserY + 1) ELSE sGotoXY(UserX,14);
  1806.           sWrite(PadRight(' ',' ',77));
  1807.         END;
  1808.         sGotoXY(UserX,UserY);
  1809.       END;
  1810.     END;
  1811.   UNTIL Quit;
  1812.   DoorSys.UpdateSecs := TRUE;
  1813.   DoorSys.UpdateIdle := TRUE;
  1814.   Set_Color(7,0);
  1815.   sClrScr;
  1816.   PurgeInput;
  1817.   AnyKey;
  1818. END;
  1819. {───────────────────────────────────────────────────────────────────────────}
  1820. PROCEDURE LineChat;
  1821. CONST
  1822.   SysopText   : BYTE = 11;
  1823.   CallerText  : BYTE = 3;
  1824. VAR
  1825.   InputKey    : CHAR;
  1826.   Loop,I      : BYTE;
  1827.   CL,
  1828.   Temp,
  1829.   RTemp,
  1830.   Movement    : STRING;
  1831.   OldLocalKey : BOOLEAN;
  1832. BEGIN
  1833.   DoorSys.UpdateSecs := FALSE;
  1834.   DoorSys.UpdateIdle := FALSE;
  1835.   CL[0]       := #0;
  1836.   Movement[0] := #0;
  1837.   OutTxtL(15,0,Ctl.SFirst+' '+Ctl.SLast+' Is Here At Your Services....');
  1838.   TextAttr    := SysopText;
  1839.   OldLocalKey := TRUE;
  1840.   REPEAT
  1841.     InputKey := sReadkey;
  1842.     IF DoorSys.LocalKey <> OldLocalKey THEN BEGIN
  1843.       IF DoorSys.LocalKey THEN TextAttr := SysopText ELSE TextAttr := CallerText;
  1844.       OldLocalKey := DoorSys.LocalKey;
  1845.     END;
  1846.     IF WrapLength <= BYTE(CL[0]) THEN BEGIN
  1847.       Temp[0]  := #0;
  1848.       RTemp[0] := #0;
  1849.       Loop     := BYTE(CL[0]);
  1850.       IF POS(#32,CL) <> 0 THEN WHILE (CL[loop] <> #32) DO BEGIN
  1851.         sWrite(#8#32#8);
  1852.         Temp := Temp + CL[Loop];
  1853.         DEC(Loop);
  1854.       END ELSE WHILE (Loop >= WrapLength) DO BEGIN
  1855.         sWrite(#8#32#8);
  1856.         Temp := Temp + CL[Loop];
  1857.         DEC(Loop);
  1858.       END;
  1859.       IF Temp[0] <> #0 THEN FOR Loop := BYTE(Temp[0]) DOWNTO 1 DO RTemp := RTemp + Temp[Loop];
  1860.       sWrite(#13+RTemp);
  1861.       CL := RTemp;
  1862.     END;
  1863.     IF (NOT (Inputkey IN [#13,#27,#8,#27,#0])) THEN BEGIN
  1864.       AnsiWrite(InputKey);
  1865.       CL := CL + InputKey;
  1866.     END ELSE
  1867.     CASE InputKey OF
  1868.       #0  : Movement := InputKey + sReadKey;
  1869.       #8  : IF CL <> '' THEN BEGIN
  1870.               sWrite(#8#32#8);
  1871.               DEC(CL[0]);
  1872.             END;
  1873.       #13 : BEGIN
  1874.               sWriteln('');
  1875.               CL := '';
  1876.             END;
  1877.       #22 : BEGIN
  1878.               sWaitInput(250);
  1879.               Movement := InputKey;
  1880.               IF sKeyPressed THEN Movement := Movement + sReadKey;
  1881.             END;
  1882.       #27 : IF NOT DoorSys.LocalKey THEN Movement := InputKey + sReadKey + sReadKey;
  1883.     END;
  1884.     IF Movement <> '' THEN BEGIN
  1885.       FOR Loop := Tty TO Ansi DO BEGIN
  1886.         IF Movement = CursorMove.Up[Loop] THEN BEGIN
  1887.           sCursorUp(1);
  1888.           Movement := '';
  1889.         END ELSE IF Movement = CursorMove.Down[Loop] THEN BEGIN
  1890.           sCursorDown(1);
  1891.           Movement := '';
  1892.         END ELSE IF Movement = CursorMove.Left[Loop] THEN BEGIN
  1893.           sCursorLeft(1);
  1894.           Movement := '';
  1895.         END ELSE IF Movement = CursorMove.Right[Loop] THEN BEGIN
  1896.           sCursorRight(1);
  1897.           Movement := '';
  1898.         END ELSE IF Movement = CursorMove.Home[Loop] THEN BEGIN
  1899.           sCursorLeft(250);
  1900.           Movement := '';
  1901.         END ELSE IF Movement = CursorMove.EndKey[Loop] THEN BEGIN
  1902.           sCursorRight(250);
  1903.           Movement := '';
  1904.         END;
  1905.       END;
  1906.       IF Movement <> '' THEN BEGIN
  1907.         FOR I := 1 TO LENGTH(Movement) DO AnsiWrite(Movement[I]);
  1908.         Movement := '';
  1909.       END;
  1910.     END;
  1911.   UNTIL (DoorSys.LocalKey AND (InputKey = #27));
  1912.   DoorSys.UpdateSecs := TRUE;
  1913.   DoorSys.UpdateIdle := TRUE;
  1914.   Set_Color(7,0);
  1915.   sClrScr;
  1916.   PurgeInput;
  1917.   AnyKey;
  1918. END;
  1919. {───────────────────────────────────────────────────────────────────────────}
  1920. PROCEDURE ChatSelect;
  1921. BEGIN
  1922.   IF Graphics = RIP THEN RipToText;
  1923.   IF Graphics = TTY THEN LineChat ELSE FullScreenChat;
  1924. END;
  1925. {───────────────────────────────────────────────────────────────────────────}
  1926. PROCEDURE DVWrite(X,Y : WORD; Attr : BYTE; S : STRING); Assembler;
  1927. {X and Y are 1 based, not 0 zero based!}
  1928. Asm
  1929.   push ds
  1930.   mov bx,[y]
  1931.   DEC bx
  1932.   SHL bx,1
  1933.   mov ax,bx
  1934. {$ifopt G+}
  1935.   SHL bx,2
  1936. {$else}
  1937.   SHL bx,1
  1938.   SHL bx,1
  1939. {$endif}
  1940.   add ax,bx
  1941.   add ax,[DVseg]
  1942.   mov es,ax
  1943.   mov di,[x]
  1944.   DEC di
  1945.   SHL di,1
  1946.   add di,[DVofs]
  1947.   lds si,s
  1948.   mov cl,BYTE PTR [si]
  1949.   INC si
  1950.   mov ah,attr
  1951. @1 :
  1952.   mov al,BYTE PTR [si]
  1953.   mov WORD PTR es : [di],ax
  1954.   INC si
  1955.   add di,2
  1956.   DEC cl
  1957.   jnz @1
  1958.   pop ds
  1959. END;
  1960. {───────────────────────────────────────────────────────────────────────────}
  1961. PROCEDURE AlertTones;
  1962. VAR
  1963.   Loop : BYTE;
  1964. BEGIN
  1965.   FOR Loop := 1 TO 5 DO BEGIN
  1966.     IF NOT Local THEN SendStr(^G) ELSE WRITE(^G);
  1967.     DELAY(200);
  1968.   END
  1969. END;
  1970. { ────────────────────────────────────────────────────────────────────────── }
  1971. END.
  1972.